File Coverage

blib/lib/Type/Tiny.pm

Criterion	Covered	Total	%
statement	700	763	92.0
branch	351	462	75.9
condition	201	300	67.0
subroutine	210	224	93.7
pod	85	85	100.0
total	1547	1834	84.4

package Type::Tiny;

use 5.008001;
use strict;
use warnings;

BEGIN {
	if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat }
}

BEGIN {
	$Type::Tiny::AUTHORITY  = 'cpan:TOBYINK';
	$Type::Tiny::VERSION    = '2.004000';
	$Type::Tiny::XS_VERSION = '0.016';
}

$Type::Tiny::VERSION    =~ tr/_//d;
$Type::Tiny::XS_VERSION =~ tr/_//d;

our @InternalPackages = qw(
	Devel::TypeTiny::Perl56Compat
	Devel::TypeTiny::Perl58Compat
	Error::TypeTiny
	Error::TypeTiny::Assertion
	Error::TypeTiny::Compilation
	Error::TypeTiny::WrongNumberOfParameters
	Eval::TypeTiny
	Eval::TypeTiny::CodeAccumulator
	Eval::TypeTiny::Sandbox
	Exporter::Tiny
	Reply::Plugin::TypeTiny
	Test::TypeTiny
	Type::Coercion
	Type::Coercion::FromMoose
	Type::Coercion::Union
	Type::Library
	Type::Params
	Type::Params::Alternatives
	Type::Params::Parameter
	Type::Params::Signature
	Type::Parser
	Type::Parser::AstBuilder
	Type::Parser::Token
	Type::Parser::TokenStream
	Type::Registry
	Types::Common
	Types::Common::Numeric
	Types::Common::String
	Types::Standard
	Types::Standard::_Stringable
	Types::Standard::ArrayRef
	Types::Standard::CycleTuple
	Types::Standard::Dict
	Types::Standard::HashRef
	Types::Standard::Map
	Types::Standard::ScalarRef
	Types::Standard::StrMatch
	Types::Standard::Tied
	Types::Standard::Tuple
	Types::TypeTiny
	Type::Tie
	Type::Tie::ARRAY
	Type::Tie::BASE
	Type::Tie::HASH
	Type::Tie::SCALAR
	Type::Tiny
	Type::Tiny::_DeclaredType
	Type::Tiny::_HalfOp
	Type::Tiny::Class
	Type::Tiny::ConsrtainedObject
	Type::Tiny::Duck
	Type::Tiny::Enum
	Type::Tiny::Intersection
	Type::Tiny::Role
	Type::Tiny::Union
	Type::Utils
);

use Scalar::Util qw( blessed );
use Types::TypeTiny ();

our $SafePackage = sprintf 'package %s;', __PACKAGE__;

sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }

sub _swap { $_[2] ? @_[ 1, 0 ] : @_[ 0, 1 ] }

BEGIN {
	my $support_smartmatch = 0+ !!( $] >= 5.010001 );
	eval qq{ sub SUPPORT_SMARTMATCH () { !! $support_smartmatch } };

	my $fixed_precedence = 0+ !!( $] >= 5.014 );
	eval qq{ sub _FIXED_PRECEDENCE () { !! $fixed_precedence } };

	my $try_xs =
		exists( $ENV{PERL_TYPE_TINY_XS} ) ? !!$ENV{PERL_TYPE_TINY_XS}
		: exists( $ENV{PERL_ONLY} )       ? !$ENV{PERL_ONLY}
		:                                   1;

	my $use_xs = 0;
	$try_xs and eval {
		require Type::Tiny::XS;
		'Type::Tiny::XS'->VERSION( $Type::Tiny::XS_VERSION );
		$use_xs++;
	};

	*_USE_XS =
		$use_xs
		? sub () { !!1 }
		: sub () { !!0 };

	*_USE_MOUSE =
		$try_xs
		? sub () { $INC{'Mouse/Util.pm'} and Mouse::Util::MOUSE_XS() }
		: sub () { !!0 };

	my $strict_mode = 0;
	$ENV{$_} && ++$strict_mode for qw(
		EXTENDED_TESTING
		AUTHOR_TESTING
		RELEASE_TESTING
		PERL_STRICT
	);
	*_STRICT_MODE = $strict_mode ? sub () { !!1 } : sub () { !!0 };
} #/ BEGIN

{

	sub _install_overloads {
		no strict 'refs';
		no warnings 'redefine', 'once';

		# Coverage is checked on Perl 5.26
		if ( $] < 5.010 ) {    # uncoverable statement
			require overload;             # uncoverable statement
			push @_, fallback => 1;       # uncoverable statement
			goto \&overload::OVERLOAD;    # uncoverable statement
		}

		my $class = shift;
		*{ $class . '::((' } = sub { };
		*{ $class . '::()' } = sub { };
		*{ $class . '::()' } = do { my $x = 1; \$x };
		while ( @_ ) {
			my $f = shift;
			*{ $class . '::(' . $f } = ref $_[0] ? shift : do {
				my $m = shift;
				sub { shift->$m( @_ ) }
			};
		}
	} #/ sub _install_overloads
}

__PACKAGE__->_install_overloads(
	q("") => sub {
		caller =~ m{^(Moo::HandleMoose|Sub::Quote)}
			? $_[0]->_stringify_no_magic
			: $_[0]->display_name;
	},
	q(bool) => sub { 1 },
	q(&{})  => "_overload_coderef",
	q(|)    => sub {
		my @tc = _swap @_;
		if ( !_FIXED_PRECEDENCE && $_[2] ) {
			if ( blessed $tc[0] ) {
				if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) {
					my $type  = $tc[0]->{type};
					my $param = $tc[0]->{param};
					my $op    = $tc[0]->{op};
					require Type::Tiny::Union;
					return "Type::Tiny::_HalfOp"->new(
						$op,
						$param,
						"Type::Tiny::Union"->new_by_overload( type_constraints => [ $type, $tc[1] ] ),
					);
				} #/ if ( blessed $tc[0] eq...)
			} #/ if ( blessed $tc[0] )
			elsif ( ref $tc[0] eq 'ARRAY' ) {
				require Type::Tiny::_HalfOp;
				return "Type::Tiny::_HalfOp"->new( '|', @tc );
			}
		} #/ if ( !_FIXED_PRECEDENCE...)
		require Type::Tiny::Union;
		return "Type::Tiny::Union"->new_by_overload( type_constraints => \@tc );
	},
	q(&) => sub {
		my @tc = _swap @_;
		if ( !_FIXED_PRECEDENCE && $_[2] ) {
			if ( blessed $tc[0] ) {
				if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) {
					my $type  = $tc[0]->{type};
					my $param = $tc[0]->{param};
					my $op    = $tc[0]->{op};
					require Type::Tiny::Intersection;
					return "Type::Tiny::_HalfOp"->new(
						$op,
						$param,
						"Type::Tiny::Intersection"->new_by_overload( type_constraints => [ $type, $tc[1] ] ),
					);
				} #/ if ( blessed $tc[0] eq...)
			} #/ if ( blessed $tc[0] )
			elsif ( ref $tc[0] eq 'ARRAY' ) {
				require Type::Tiny::_HalfOp;
				return "Type::Tiny::_HalfOp"->new( '&', @tc );
			}
		} #/ if ( !_FIXED_PRECEDENCE...)
		require Type::Tiny::Intersection;
		"Type::Tiny::Intersection"->new_by_overload( type_constraints => \@tc );
	},
	q(~)  => sub { shift->complementary_type },
	q(==) => sub { $_[0]->equals( $_[1] ) },
	q(!=) => sub { not $_[0]->equals( $_[1] ) },
	q(<)  => sub { my $m = $_[0]->can( 'is_subtype_of' ); $m->( _swap @_ ) },
	q(>)  => sub {
		my $m = $_[0]->can( 'is_subtype_of' );
		$m->( reverse _swap @_ );
	},
	q(<=) => sub { my $m = $_[0]->can( 'is_a_type_of' ); $m->( _swap @_ ) },
	q(>=) => sub {
		my $m = $_[0]->can( 'is_a_type_of' );
		$m->( reverse _swap @_ );
	},
	q(eq)  => sub { "$_[0]" eq "$_[1]" },
	q(cmp) => sub { $_[2] ? ( "$_[1]" cmp "$_[0]" ) : ( "$_[0]" cmp "$_[1]" ) },
	q(0+)  => sub { $_[0]{uniq} },
	q(/)   => sub { ( _STRICT_MODE xor $_[2] ) ? $_[0] : $_[1] },
);

__PACKAGE__->_install_overloads(
	q(~~) => sub { $_[0]->check( $_[1] ) },
) if Type::Tiny::SUPPORT_SMARTMATCH;

# Would be easy to just return sub { $self->assert_return(@_) }
# but try to build a more efficient coderef whenever possible.
#
sub _overload_coderef {
	my $self = shift;

	# Bypass generating a coderef if we've already got the best possible one.
	#
	return $self->{_overload_coderef} if $self->{_overload_coderef_no_rebuild};

	# Subclasses of Type::Tiny might override assert_return to do some kind
	# of interesting thing. In that case, we can't rely on it having identical
	# behaviour to Type::Tiny::inline_assert.
	#
	$self->{_overrides_assert_return} =
		( $self->can( 'assert_return' ) != \&assert_return )
		unless exists $self->{_overrides_assert_return};

	if ( $self->{_overrides_assert_return} ) {
		$self->{_overload_coderef} ||= do {
			Scalar::Util::weaken( my $weak = $self );
			sub { $weak->assert_return( @_ ) };
		};
		++$self->{_overload_coderef_no_rebuild};
	}
	elsif ( exists( &Sub::Quote::quote_sub ) ) {

		# Use `=` instead of `||=` because we want to overwrite non-Sub::Quote
		# coderef if possible.
		$self->{_overload_coderef} = $self->can_be_inlined
			? Sub::Quote::quote_sub(
			$self->inline_assert( '$_[0]' ),
			)
			: Sub::Quote::quote_sub(
			$self->inline_assert( '$_[0]', '$type' ),
			{ '$type' => \$self },
			);
		++$self->{_overload_coderef_no_rebuild};
	} #/ elsif ( exists( &Sub::Quote::quote_sub...))
	else {
		require Eval::TypeTiny;
		$self->{_overload_coderef} ||= $self->can_be_inlined
			? Eval::TypeTiny::eval_closure(
			source => sprintf(
				'sub { %s }', $self->inline_assert( '$_[0]', undef, no_wrapper => 1 )
			),
			description => sprintf( "compiled assertion 'assert_%s'", $self ),
			)
			: Eval::TypeTiny::eval_closure(
			source => sprintf(
				'sub { %s }', $self->inline_assert( '$_[0]', '$type', no_wrapper => 1 )
			),
			description => sprintf( "compiled assertion 'assert_%s'", $self ),
			environment => { '$type' => \$self },
			);
	} #/ else [ if ( $self->{_overrides_assert_return...})]

	$self->{_overload_coderef};
} #/ sub _overload_coderef

our %ALL_TYPES;

my $QFS;
my $uniq = 1;

sub new {
	my $class  = shift;
	my %params = ( @_ == 1 ) ? %{ $_[0] } : @_;

	for ( qw/ name display_name library / ) {
		$params{$_} = $params{$_} . '' if defined $params{$_};
	}

	my $level = 0;
	while ( not exists $params{definition_context} and $level < 20 ) {
		our $_TT_GUTS ||= do {
			my $g = join '|', map quotemeta, grep !m{^Types::}, @InternalPackages;
			qr/\A(?:$g)\z/o
		};
		my $package = caller $level;
		if ( $package !~ $_TT_GUTS ) {
			@{ $params{definition_context} = {} }{ qw/ package file line / } = caller $level;
		}
		++$level;
	}

	if ( exists $params{parent} ) {
		$params{parent} =
			ref( $params{parent} ) =~ /^Type::Tiny\b/
			? $params{parent}
			: Types::TypeTiny::to_TypeTiny( $params{parent} );

		_croak "Parent must be an instance of %s", __PACKAGE__
			unless blessed( $params{parent} )
			&& $params{parent}->isa( __PACKAGE__ );

		if ( $params{parent}->deprecated and not exists $params{deprecated} ) {
			$params{deprecated} = 1;
		}
	} #/ if ( exists $params{parent...})

	if ( exists $params{constraint}
		and defined $params{constraint}
		and not ref $params{constraint} )
	{
		require Eval::TypeTiny;
		my $code = $params{constraint};
		$params{constraint} = Eval::TypeTiny::eval_closure(
			source      => sprintf( 'sub ($) { %s }', $code ),
			description => "anonymous check",
		);
		$params{inlined} ||= sub {
			my ( $type ) = @_;
			my $inlined  = $_ eq '$_' ? "do { $code }" : "do { local \$_ = $_; $code }";
			$type->has_parent ? ( undef, $inlined ) : $inlined;
			}
			if ( !exists $params{parent} or $params{parent}->can_be_inlined );
	} #/ if ( exists $params{constraint...})

	# canonicalize to a boolean
	$params{deprecated} = !!$params{deprecated};

	$params{name} = "__ANON__" unless exists $params{name};
	$params{uniq} = $uniq++;

	if ( $params{name} ne "__ANON__" ) {

		# First try a fast ASCII-only expression, but fall back to Unicode
		$params{name} =~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm
			or eval q( use 5.008; $params{name} =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm )
			or _croak '"%s" is not a valid type name', $params{name};
	}

	if ( exists $params{coercion} and !ref $params{coercion} and $params{coercion} )
	{
		$params{parent}->has_coercion
			or _croak
			"coercion => 1 requires type to have a direct parent with a coercion";

		$params{coercion} = $params{parent}->coercion->type_coercion_map;
	}

	if ( !exists $params{inlined}
		and exists $params{constraint}
		and ( !exists $params{parent} or $params{parent}->can_be_inlined )
		and $QFS ||= "Sub::Quote"->can( "quoted_from_sub" ) )
	{
		my ( undef, $perlstring, $captures ) = @{ $QFS->( $params{constraint} ) || [] };

		$params{inlined} = sub {
			my ( $self, $var ) = @_;
			my $code = Sub::Quote::inlinify(
				$perlstring,
				$var,
				$var eq q($_) ? '' : "local \$_ = $var;",
				1,
			);
			$code = sprintf( '%s and %s', $self->parent->inline_check( $var ), $code )
				if $self->has_parent;
			return $code;
			}
			if $perlstring && !$captures;
	} #/ if ( !exists $params{inlined...})

	my $self = bless \%params, $class;

	unless ( $params{tmp} ) {
		my $uniq = $self->{uniq};

		$ALL_TYPES{$uniq} = $self;
		Scalar::Util::weaken( $ALL_TYPES{$uniq} );

		my $tmp = $self;
		Scalar::Util::weaken( $tmp );
		$Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } = sub { $tmp };
	} #/ unless ( $params{tmp} )

	if ( ref( $params{coercion} ) eq q(CODE) ) {
		require Types::Standard;
		my $code = delete( $params{coercion} );
		$self->{coercion} = $self->_build_coercion;
		$self->coercion->add_type_coercions( Types::Standard::Any(), $code );
	}
	elsif ( ref( $params{coercion} ) eq q(ARRAY) ) {
		my $arr = delete( $params{coercion} );
		$self->{coercion} = $self->_build_coercion;
		$self->coercion->add_type_coercions( @$arr );
	}

	# Documenting this here because it's too weird to be in the pod.
	# There's a secret attribute called "_build_coercion" which takes a
	# coderef. If present, then when $type->coercion is lazy built,
	# the blank Type::Coercion object gets passed to the coderef,
	# allowing the coderef to manipulate it a little. This is used by
	# Types::TypeTiny to allow it to build a coercion for the TypeTiny
	# type constraint without needing to load Type::Coercion yet.

	if ( $params{my_methods} ) {
		require Eval::TypeTiny;
		Scalar::Util::reftype( $params{my_methods}{$_} ) eq 'CODE'
			and Eval::TypeTiny::set_subname(
				sprintf( "%s::my_%s", $self->qualified_name, $_ ),
				$params{my_methods}{$_},
			) for keys %{ $params{my_methods} };
	} #/ if ( $params{my_methods...})

	# In general, mutating a type constraint after it's been created
	# is a bad idea and will probably not work. However some places are
	# especially harmful and can lead to confusing errors, so allow
	# subclasses to lock down particular keys.
	#
	$self->_lockdown( sub {
		&Internals::SvREADONLY( $_, !!1 ) for @_;
	} );

	return $self;
} #/ sub new

sub _lockdown {}

sub DESTROY {
	my $self = shift;
	delete( $ALL_TYPES{ $self->{uniq} } );
	delete( $Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } );
	return;
}

sub _clone {
	my $self = shift;
	my %opts;
	$opts{$_} = $self->{$_} for qw< name display_name message >;
	$self->create_child_type( %opts );
}

sub _stringify_no_magic {
	sprintf(
		'%s=%s(0x%08x)', blessed( $_[0] ), Scalar::Util::reftype( $_[0] ),
		Scalar::Util::refaddr( $_[0] )
	);
}

our $DD;

sub _dd {
	@_ = $_ unless @_;
	my ( $value ) = @_;

	goto $DD if ref( $DD ) eq q(CODE);

	require B;

	!defined $value  ? 'Undef'
		: !ref $value ? sprintf( 'Value %s', B::perlstring( $value ) )
		: do {
		my $N = 0+ ( defined( $DD ) ? $DD : 72 );
		require Data::Dumper;
		local $Data::Dumper::Indent   = 0;
		local $Data::Dumper::Useqq    = 1;
		local $Data::Dumper::Terse    = 1;
		local $Data::Dumper::Sortkeys = 1;
		local $Data::Dumper::Maxdepth = 2;
		my $str;
		eval {
			$str = Data::Dumper::Dumper( $value );
			$str = substr( $str, 0, $N - 12 ) . '...' . substr( $str, -1, 1 )
				if length( $str ) >= $N;
			1;
		} or do { $str = 'which cannot be dumped' };
		"Reference $str";
	} #/ do
} #/ sub _dd

sub _loose_to_TypeTiny {
	my $caller = caller( 1 ); # assumption
	map +(
		ref( $_ )
		? Types::TypeTiny::to_TypeTiny( $_ )
		: do { require Type::Utils; Type::Utils::dwim_type( $_, for => $caller ) }
	), @_;
}

sub name         { $_[0]{name} }
sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name }
sub parent       { $_[0]{parent} }
sub constraint   { $_[0]{constraint} ||= $_[0]->_build_constraint }

sub compiled_check {
	$_[0]{compiled_type_constraint} ||= $_[0]->_build_compiled_check;
}
sub coercion             { $_[0]{coercion} ||= $_[0]->_build_coercion }
sub message              { $_[0]{message} }
sub library              { $_[0]{library} }
sub inlined              { $_[0]{inlined} }
sub deprecated           { $_[0]{deprecated} }
sub constraint_generator { $_[0]{constraint_generator} }
sub inline_generator     { $_[0]{inline_generator} }
sub name_generator       { $_[0]{name_generator} ||= $_[0]->_build_name_generator }
sub coercion_generator   { $_[0]{coercion_generator} }
sub parameters           { $_[0]{parameters} }
sub moose_type           { $_[0]{moose_type} ||= $_[0]->_build_moose_type }
sub mouse_type           { $_[0]{mouse_type} ||= $_[0]->_build_mouse_type }
sub deep_explanation     { $_[0]{deep_explanation} }
sub my_methods           { $_[0]{my_methods} ||= $_[0]->_build_my_methods }
sub sorter               { $_[0]{sorter} }
sub exception_class      { $_[0]{exception_class} ||= $_[0]->_build_exception_class }

sub has_parent               { exists $_[0]{parent} }
sub has_library              { exists $_[0]{library} }
sub has_inlined              { exists $_[0]{inlined} }
sub has_constraint_generator { exists $_[0]{constraint_generator} }
sub has_inline_generator     { exists $_[0]{inline_generator} }
sub has_coercion_generator   { exists $_[0]{coercion_generator} }
sub has_parameters           { exists $_[0]{parameters} }
sub has_message              { defined $_[0]{message} }
sub has_deep_explanation     { exists $_[0]{deep_explanation} }
sub has_sorter               { exists $_[0]{sorter} }

sub _default_message {
	$_[0]{_default_message} ||= $_[0]->_build_default_message;
}

sub has_coercion {
	$_[0]->coercion if $_[0]{_build_coercion};    # trigger auto build thing
	$_[0]{coercion} and !!@{ $_[0]{coercion}->type_coercion_map };
}

sub _assert_coercion {
	my $self = shift;
	return $self->coercion if $self->{_build_coercion};    # trigger auto build thing
	_croak "No coercion for this type constraint"
		unless $self->has_coercion
		&& @{ $self->coercion->type_coercion_map };
	$self->coercion;
}

my $null_constraint = sub { !!1 };

sub _build_display_name {
	shift->name;
}

sub _build_constraint {
	return $null_constraint;
}

sub _is_null_constraint {
	shift->constraint == $null_constraint;
}

sub _build_coercion {
	require Type::Coercion;
	my $self = shift;
	my %opts = ( type_constraint => $self );
	$opts{display_name} = "to_$self" unless $self->is_anon;
	my $coercion = "Type::Coercion"->new( %opts );
	$self->{_build_coercion}->( $coercion ) if ref $self->{_build_coercion};
	$coercion;
}

sub _build_default_message {
	my $self = shift;
	$self->{is_using_default_message} = 1;
	return sub { sprintf '%s did not pass type constraint', _dd( $_[0] ) }
		if "$self" eq "__ANON__";
	my $name = "$self";
	return sub {
		sprintf '%s did not pass type constraint "%s"', _dd( $_[0] ), $name;
	};
} #/ sub _build_default_message

sub _build_name_generator {
	my $self = shift;
	return sub {
		defined && s/[\x00-\x1F]//smg for ( my ( $s, @a ) = @_ );
		sprintf( '%s[%s]', $s, join q[,], map !defined() ? 'undef' : !ref() && /\W/ ? B::perlstring($_) : $_, @a );
	};
}

sub _build_compiled_check {
	my $self = shift;

	local our $AvoidCallbacks = 0;

	if ( $self->_is_null_constraint and $self->has_parent ) {
		return $self->parent->compiled_check;
	}

	require Eval::TypeTiny;
	return Eval::TypeTiny::eval_closure(
		source      => sprintf( 'sub ($) { %s }',      $self->inline_check( '$_[0]' ) ),
		description => sprintf( "compiled check '%s'", $self ),
	) if $self->can_be_inlined;

	my @constraints;
	push @constraints, $self->parent->compiled_check if $self->has_parent;
	push @constraints, $self->constraint             if !$self->_is_null_constraint;
	return $null_constraint unless @constraints;

	return sub ($) {
		local $_ = $_[0];
		for my $c ( @constraints ) {
			return unless $c->( @_ );
		}
		return !!1;
	};
} #/ sub _build_compiled_check

sub _build_exception_class {
	my $self = shift;
	return $self->parent->exception_class if $self->has_parent;
	require Error::TypeTiny::Assertion;
	return 'Error::TypeTiny::Assertion';
}

sub definition_context {
	my $self  = shift;
	my $found = $self->find_parent(sub {
		ref $_->{definition_context} and exists $_->{definition_context}{file};
	});
	$found ? $found->{definition_context} : {};
}

sub find_constraining_type {
	my $self = shift;
	if ( $self->_is_null_constraint and $self->has_parent ) {
		return $self->parent->find_constraining_type;
	}
	$self;
}

sub type_default {
	my ( $self, @args ) = @_;
	if ( exists $self->{type_default} ) {
		if ( @args ) {
			my $td = $self->{type_default};
			return sub { local $_ = \@args; &$td; };
		}
		return $self->{type_default};
	}
	if ( my $parent = $self->parent ) {
		return $parent->type_default( @args ) if $self->_is_null_constraint;
	}
	return undef;
}

our @CMP;

sub CMP_SUPERTYPE ()  { -1 }
sub CMP_EQUAL ()      { 0 }
sub CMP_EQUIVALENT () { '0E0' }
sub CMP_SUBTYPE ()    { 1 }
sub CMP_UNKNOWN ()    { ''; }

# avoid getting mixed up with cmp operator at compile time
*cmp = sub {
	my ( $A, $B ) = _loose_to_TypeTiny( $_[0], $_[1] );
	return unless blessed( $A ) && $A->isa( "Type::Tiny" );
	return unless blessed( $B ) && $B->isa( "Type::Tiny" );
	for my $comparator ( @CMP ) {
		my $result = $comparator->( $A, $B );
		next if $result eq CMP_UNKNOWN;
		if ( $result eq CMP_EQUIVALENT ) {
			my $prefer = @_ == 3 ? $_[2] : CMP_EQUAL;
			return $prefer;
		}
		return $result;
	}
	return CMP_UNKNOWN;
};

push @CMP, sub {
	my ( $A, $B ) = @_;
	return CMP_EQUAL
		if Scalar::Util::refaddr( $A ) == Scalar::Util::refaddr( $B );

	return CMP_EQUIVALENT
		if Scalar::Util::refaddr( $A->compiled_check ) ==
		Scalar::Util::refaddr( $B->compiled_check );

	my $A_stem = $A->find_constraining_type;
	my $B_stem = $B->find_constraining_type;
	return CMP_EQUIVALENT
		if Scalar::Util::refaddr( $A_stem ) == Scalar::Util::refaddr( $B_stem );
	return CMP_EQUIVALENT
		if Scalar::Util::refaddr( $A_stem->compiled_check ) ==
		Scalar::Util::refaddr( $B_stem->compiled_check );

	if ( $A_stem->can_be_inlined and $B_stem->can_be_inlined ) {
		return CMP_EQUIVALENT
			if $A_stem->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' );
	}

	A_IS_SUBTYPE: {
		my $A_prime = $A_stem;
		while ( $A_prime->has_parent ) {
			$A_prime = $A_prime->parent;
			return CMP_SUBTYPE
				if Scalar::Util::refaddr( $A_prime ) == Scalar::Util::refaddr( $B_stem );
			return CMP_SUBTYPE
				if Scalar::Util::refaddr( $A_prime->compiled_check ) ==
				Scalar::Util::refaddr( $B_stem->compiled_check );
			if ( $A_prime->can_be_inlined and $B_stem->can_be_inlined ) {
				return CMP_SUBTYPE
					if $A_prime->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' );
			}
		} #/ while ( $A_prime->has_parent)
	} #/ A_IS_SUBTYPE:

	B_IS_SUBTYPE: {
		my $B_prime = $B_stem;
		while ( $B_prime->has_parent ) {
			$B_prime = $B_prime->parent;
			return CMP_SUPERTYPE
				if Scalar::Util::refaddr( $B_prime ) == Scalar::Util::refaddr( $A_stem );
			return CMP_SUPERTYPE
				if Scalar::Util::refaddr( $B_prime->compiled_check ) ==
				Scalar::Util::refaddr( $A_stem->compiled_check );
			if ( $A_stem->can_be_inlined and $B_prime->can_be_inlined ) {
				return CMP_SUPERTYPE
					if $B_prime->inline_check( '$WOLFIE' ) eq $A_stem->inline_check( '$WOLFIE' );
			}
		} #/ while ( $B_prime->has_parent)
	} #/ B_IS_SUBTYPE:

	return CMP_UNKNOWN;
};

sub equals {
	my $result = Type::Tiny::cmp( $_[0], $_[1] );
	return unless defined $result;
	$result eq CMP_EQUAL;
}

sub is_subtype_of {
	my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE );
	return unless defined $result;
	$result eq CMP_SUBTYPE;
}

sub is_supertype_of {
	my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE );
	return unless defined $result;
	$result eq CMP_SUPERTYPE;
}

sub is_a_type_of {
	my $result = Type::Tiny::cmp( $_[0], $_[1] );
	return unless defined $result;
	$result eq CMP_SUBTYPE or $result eq CMP_EQUAL or $result eq CMP_EQUIVALENT;
}

sub strictly_equals {
	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
	return unless blessed( $other ) && $other->isa( "Type::Tiny" );
	$self->{uniq} == $other->{uniq};
}

sub is_strictly_subtype_of {
	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
	return unless blessed( $other ) && $other->isa( "Type::Tiny" );

	return unless $self->has_parent;
	$self->parent->strictly_equals( $other )
		or $self->parent->is_strictly_subtype_of( $other );
}

sub is_strictly_supertype_of {
	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
	return unless blessed( $other ) && $other->isa( "Type::Tiny" );

	$other->is_strictly_subtype_of( $self );
}

sub is_strictly_a_type_of {
	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
	return unless blessed( $other ) && $other->isa( "Type::Tiny" );

	$self->strictly_equals( $other ) or $self->is_strictly_subtype_of( $other );
}

sub qualified_name {
	my $self = shift;
	( exists $self->{library} and $self->name ne "__ANON__" )
		? "$self->{library}::$self->{name}"
		: $self->{name};
}

sub is_anon {
	my $self = shift;
	$self->name eq "__ANON__";
}

sub parents {
	my $self = shift;
	return unless $self->has_parent;
	return ( $self->parent, $self->parent->parents );
}

sub find_parent {
	my $self = shift;
	my ( $test ) = @_;

	local ( $_, $. );
	my $type  = $self;
	my $count = 0;
	while ( $type ) {
		if ( $test->( $_ = $type, $. = $count ) ) {
			return wantarray ? ( $type, $count ) : $type;
		}
		else {
			$type = $type->parent;
			$count++;
		}
	}

	return;
} #/ sub find_parent

sub check {
	my $self = shift;
	( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )->( @_ );
}

sub _strict_check {
	my $self = shift;
	local $_ = $_[0];

	my @constraints =
		reverse
		map { $_->constraint }
		grep { not $_->_is_null_constraint } ( $self, $self->parents );

	for my $c ( @constraints ) {
		return unless $c->( @_ );
	}

	return !!1;
} #/ sub _strict_check

sub get_message {
	my $self = shift;
	local $_ = $_[0];
	$self->has_message
		? $self->message->( @_ )
		: $self->_default_message->( @_ );
}

sub validate {
	my $self = shift;

	return undef
		if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )
		->( @_ );

	local $_ = $_[0];
	return $self->get_message( @_ );
} #/ sub validate

sub validate_explain {
	my $self = shift;
	my ( $value, $varname ) = @_;
	$varname = '$_' unless defined $varname;

	return undef if $self->check( $value );

	if ( $self->has_parent ) {
		my $parent = $self->parent->validate_explain( $value, $varname );
		return [
			sprintf( '"%s" is a subtype of "%s"', $self, $self->parent ),
			@$parent
			]
			if $parent;
	}

	my $message = sprintf(
		'%s%s',
		$self->get_message( $value ),
		$varname eq q{$_} ? '' : sprintf( ' (in %s)', $varname ),
	);

	if ( $self->is_parameterized and $self->parent->has_deep_explanation ) {
		my $deep = $self->parent->deep_explanation->( $self, $value, $varname );
		return [ $message, @$deep ] if $deep;
	}

	local $SIG{__WARN__} = sub {};
	return [
		$message,
		sprintf( '"%s" is defined as: %s', $self, $self->_perlcode )
	];
} #/ sub validate_explain

my $b;

sub _perlcode {
	my $self = shift;

	local our $AvoidCallbacks = 1;
	return $self->inline_check( '$_' )
		if $self->can_be_inlined;

	$b ||= do {
		local $@;
		require B::Deparse;
		my $tmp = "B::Deparse"->new;
		$tmp->ambient_pragmas( strict => "all", warnings => "all" )
			if $tmp->can( 'ambient_pragmas' );
		$tmp;
	};

	my $code = $b->coderef2text( $self->constraint );
	$code =~ s/\s+/ /g;
	return "sub $code";
} #/ sub _perlcode

sub assert_valid {
	my $self = shift;

	return !!1
		if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )
		->( @_ );

	local $_ = $_[0];
	$self->_failed_check( "$self", $_ );
} #/ sub assert_valid

sub assert_return {
	my $self = shift;

	return $_[0]
		if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )
		->( @_ );

	local $_ = $_[0];
	$self->_failed_check( "$self", $_ );
} #/ sub assert_return

sub can_be_inlined {
	my $self = shift;
	return $self->parent->can_be_inlined
		if $self->has_parent && $self->_is_null_constraint;
	return !!1
		if !$self->has_parent && $self->_is_null_constraint;
	return $self->has_inlined;
}

sub inline_check {
	my $self = shift;
	_croak 'Cannot inline type constraint check for "%s"', $self
		unless $self->can_be_inlined;

	return $self->parent->inline_check( @_ )
		if $self->has_parent && $self->_is_null_constraint;
	return '(!!1)'
		if !$self->has_parent && $self->_is_null_constraint;

	local $_ = $_[0];
	my @r = $self->inlined->( $self, @_ );
	if ( @r and not defined $r[0] ) {
		_croak 'Inlining type constraint check for "%s" returned undef!', $self
			unless $self->has_parent;
		$r[0] = $self->parent->inline_check( @_ );
	}
	my $r = join " && " => map {
		/[;{}]/ && !/\Ado \{.+\}\z/
			? "do { $SafePackage $_ }"
			: "($_)"
	} @r;
	return @r == 1 ? $r : "($r)";
} #/ sub inline_check

sub inline_assert {
	require B;
	my $self = shift;
	my ( $varname, $typevarname, %extras ) = @_;

	$extras{exception_class} ||= $self->exception_class;

	my $inline_check;
	if ( $self->can_be_inlined ) {
		$inline_check = sprintf( '(%s)', $self->inline_check( $varname ) );
	}
	elsif ( $typevarname ) {
		$inline_check = sprintf( '%s->check(%s)', $typevarname, $varname );
	}
	else {
		_croak 'Cannot inline type constraint check for "%s"', $self;
	}

	my $do_wrapper = !delete $extras{no_wrapper};

	my $inline_throw;
	if ( $typevarname ) {
		$inline_throw = sprintf(
			'Type::Tiny::_failed_check(%s, %s, %s, %s)',
			$typevarname,
			B::perlstring( "$self" ),
			$varname,
			join(
				',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ),
				sort keys %extras
			),
		);
	} #/ if ( $typevarname )
	else {
		$inline_throw = sprintf(
			'Type::Tiny::_failed_check(%s, %s, %s, %s)',
			$self->{uniq},
			B::perlstring( "$self" ),
			$varname,
			join(
				',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ),
				sort keys %extras
			),
		);
	} #/ else [ if ( $typevarname ) ]

	$do_wrapper
		? qq[do { no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname };]
		: qq[     no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname   ];
} #/ sub inline_assert

sub _failed_check {
	my ( $self, $name, $value, %attrs ) = @_;
	$self = $ALL_TYPES{$self} if defined $self && !ref $self;

	my $exception_class = delete( $attrs{exception_class} )
		|| ( ref $self ? $self->exception_class : 'Error::TypeTiny::Assertion' );
	my $callback = delete( $attrs{on_die} );

	if ( $self ) {
		return $exception_class->throw_cb(
			$callback,
			message => $self->get_message( $value ),
			type    => $self,
			value   => $value,
			%attrs,
		);
	}
	else {
		return $exception_class->throw_cb(
			$callback,
			message => sprintf( '%s did not pass type constraint "%s"', _dd( $value ), $name ),
			value => $value,
			%attrs,
		);
	}
} #/ sub _failed_check

sub coerce {
	my $self = shift;
	$self->_assert_coercion->coerce( @_ );
}

sub assert_coerce {
	my $self = shift;
	$self->_assert_coercion->assert_coerce( @_ );
}

sub is_parameterizable {
	shift->has_constraint_generator;
}

sub is_parameterized {
	shift->has_parameters;
}

{
	my %seen;

	sub ____make_key {
		#<<<
		join ',', map {
			Types::TypeTiny::is_TypeTiny( $_ )  ? sprintf( '$Type::Tiny::ALL_TYPES{%s}', defined( $_->{uniq} ) ? $_->{uniq} : '____CANNOT_KEY____' ) :
			ref() eq 'ARRAY'                    ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '[%s]', ____make_key( @$_ ) ) } :
			ref() eq 'HASH'                     ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '{%s}', ____make_key( do { my %h = %$_; map +( $_, $h{$_} ), sort keys %h; } ) ) } :
			ref() eq 'SCALAR' || ref() eq 'REF' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '\\(%s)', ____make_key( $$_ ) ) } :
			!defined()                          ? 'undef' :
			!ref()                              ? do { require B; B::perlstring( $_ ) } :
			'____CANNOT_KEY____';
		} @_;
		#>>>
	} #/ sub ____make_key
	my %param_cache;

	sub parameterize {
		my $self = shift;

		$self->is_parameterizable
			or @_
			? _croak( "Type '%s' does not accept parameters", "$self" )
			: return ( $self );

		@_ = map Types::TypeTiny::to_TypeTiny( $_ ), @_;

		# Generate a key for caching parameterized type constraints,
		# but only if all the parameters are strings or type constraints.
		%seen = ();
		my $key = $self->____make_key( @_ );
		undef( $key )             if $key =~ /____CANNOT_KEY____/;
		return $param_cache{$key} if defined $key && defined $param_cache{$key};

		local $Type::Tiny::parameterize_type = $self;
		local $_                             = $_[0];
		my $P;

		my ( $constraint, $compiled ) = $self->constraint_generator->( @_ );

		if ( Types::TypeTiny::is_TypeTiny( $constraint ) ) {
			$P = $constraint;
		}
		else {
			my %options = (
				constraint   => $constraint,
				display_name => $self->name_generator->( $self, @_ ),
				parameters   => [@_],
			);
			$options{compiled_type_constraint} = $compiled
				if $compiled;
			$options{inlined} = $self->inline_generator->( @_ )
				if $self->has_inline_generator;
			$options{type_default} = $self->{type_default_generator}->( @_ )
				if exists $self->{type_default_generator}; # undocumented
			exists $options{$_} && !defined $options{$_} && delete $options{$_}
				for keys %options;

			$P = $self->create_child_type( %options );

			if ( $self->has_coercion_generator ) {
				my @args = @_;
				$P->{_build_coercion} = sub {
					my $coercion = shift;
					my $built    = $self->coercion_generator->( $self, $P, @args );
					$coercion->add_type_coercions( @{ $built->type_coercion_map } ) if $built;
					$coercion->freeze;
				};
			}
		} #/ else [ if ( Types::TypeTiny::is_TypeTiny...)]

		if ( defined $key ) {
			$param_cache{$key} = $P;
			Scalar::Util::weaken( $param_cache{$key} );
		}

		$P->coercion->freeze unless $self->has_coercion_generator;

		return $P;
	} #/ sub parameterize
}

sub child_type_class {
	__PACKAGE__;
}

sub create_child_type {
	my $self = shift;
	my %moreopts;
	$moreopts{is_object} = 1 if $self->{is_object};
	return $self->child_type_class->new( parent => $self, %moreopts, @_ );
}

sub complementary_type {
	my $self = shift;
	my $r    = ( $self->{complementary_type} ||= $self->_build_complementary_type );
	Scalar::Util::weaken( $self->{complementary_type} )
		unless Scalar::Util::isweak( $self->{complementary_type} );
	return $r;
}

sub _build_complementary_type {
	my $self = shift;
	my %opts = (
		constraint   => sub { not $self->check( $_ ) },
		display_name => sprintf( "~%s", $self ),
	);
	$opts{display_name} =~ s/^\~{2}//;
	$opts{inlined} = sub { shift; "not(" . $self->inline_check( @_ ) . ")" }
		if $self->can_be_inlined;
	$opts{display_name} = $opts{name} = $self->{complement_name}
		if $self->{complement_name};
	return "Type::Tiny"->new( %opts );
} #/ sub _build_complementary_type

sub _instantiate_moose_type {
	my $self = shift;
	my %opts = @_;
	require Moose::Meta::TypeConstraint;
	return "Moose::Meta::TypeConstraint"->new( %opts );
}

sub _build_moose_type {
	my $self = shift;

	my $r;
	if ( $self->{_is_core} ) {
		require Moose::Util::TypeConstraints;
		$r = Moose::Util::TypeConstraints::find_type_constraint( $self->name );
		$r->{"Types::TypeTiny::to_TypeTiny"} = $self;
		Scalar::Util::weaken( $r->{"Types::TypeTiny::to_TypeTiny"} );
	}
	else {
		# Type::Tiny is more flexible than Moose, allowing
		# inlined to return a list. So we need to wrap the
		# inlined coderef to make sure Moose gets a single
		# string.
		#
		my $wrapped_inlined = sub {
			shift;
			$self->inline_check( @_ );
		};

		my %opts;
		$opts{name}   = $self->qualified_name if $self->has_library && !$self->is_anon;
		$opts{parent} = $self->parent->moose_type if $self->has_parent;
		$opts{constraint} = $self->constraint unless $self->_is_null_constraint;
		$opts{message}    = $self->message   if $self->has_message;
		$opts{inlined}    = $wrapped_inlined if $self->has_inlined;

		$r                                   = $self->_instantiate_moose_type( %opts );
		$r->{"Types::TypeTiny::to_TypeTiny"} = $self;
		$self->{moose_type}                  = $r;                                     # prevent recursion
		$r->coercion( $self->coercion->moose_coercion ) if $self->has_coercion;
	} #/ else [ if ( $self->{_is_core})]

	return $r;
} #/ sub _build_moose_type

sub _build_mouse_type {
	my $self = shift;

	my %options;
	$options{name} = $self->qualified_name if $self->has_library && !$self->is_anon;
	$options{parent}     = $self->parent->mouse_type if $self->has_parent;
	$options{constraint} = $self->constraint unless $self->_is_null_constraint;
	$options{message}    = $self->message if $self->has_message;

	require Mouse::Meta::TypeConstraint;
	my $r = "Mouse::Meta::TypeConstraint"->new( %options );

	$self->{mouse_type} = $r;    # prevent recursion
	$r->_add_type_coercions(
		$self->coercion->freeze->_codelike_type_coercion_map( 'mouse_type' ) )
		if $self->has_coercion;

	return $r;
} #/ sub _build_mouse_type

sub exportables {
	my ( $self, $base_name, $tag ) = ( shift, @_ ); # $tag is undocumented
	if ( not $self->is_anon ) {
		$base_name ||= $self->name;
	}
	$tag ||= 0;

	my @exportables;
	return \@exportables if ! $base_name;

	require Eval::TypeTiny;

	push @exportables, {
		name => $base_name,
		code => Eval::TypeTiny::type_to_coderef( $self ),
		tags => [ 'types' ],
	} if $tag eq 'types' || !$tag;

	push @exportables, {
		name => sprintf( 'is_%s', $base_name ),
		code => $self->compiled_check,
		tags => [ 'is' ],
	} if $tag eq 'is' || !$tag;

	push @exportables, {
		name => sprintf( 'assert_%s', $base_name ),
		code => $self->_overload_coderef,
		tags => [ 'assert' ],
	} if $tag eq 'assert' || !$tag;

	push @exportables, {
		name => sprintf( 'to_%s', $base_name ),
		code => $self->has_coercion && $self->coercion->frozen
			? $self->coercion->compiled_coercion
			: sub ($) { $self->coerce( $_[0] ) },
		tags => [ 'to' ],
	} if $tag eq 'to' || !$tag;

	return \@exportables;
}

sub exportables_by_tag {
	my ( $self, $tag, $base_name ) = ( shift, @_ );
	my @matched = grep {
		my $e = $_;
		grep $_ eq $tag, @{ $e->{tags} || [] };
	} @{ $self->exportables( $base_name, $tag ) };
	return @matched if wantarray;
	_croak( 'Expected to find one exportable tagged "%s", found %d', $tag, scalar @matched )
		unless @matched == 1;
	return $matched[0];
}

sub _process_coercion_list {
	my $self = shift;

	my @pairs;
	while ( @_ ) {
		my $next = shift;
		if ( blessed( $next )
			and $next->isa( 'Type::Coercion' )
			and $next->is_parameterized )
		{
			push @pairs => ( @{ $next->_reparameterize( $self )->type_coercion_map } );
		}
		elsif ( blessed( $next ) and $next->can( 'type_coercion_map' ) ) {
			push @pairs => (
				@{ $next->type_coercion_map },
			);
		}
		elsif ( ref( $next ) eq q(ARRAY) ) {
			unshift @_, @$next;
		}
		else {
			push @pairs => (
				Types::TypeTiny::to_TypeTiny( $next ),
				shift,
			);
		}
	} #/ while ( @_ )

	return @pairs;
} #/ sub _process_coercion_list

sub plus_coercions {
	my $self = shift;
	my $new  = $self->_clone;
	$new->coercion->add_type_coercions(
		$self->_process_coercion_list( @_ ),
		@{ $self->coercion->type_coercion_map },
	);
	$new->coercion->freeze;
	return $new;
} #/ sub plus_coercions

sub plus_fallback_coercions {
	my $self = shift;

	my $new = $self->_clone;
	$new->coercion->add_type_coercions(
		@{ $self->coercion->type_coercion_map },
		$self->_process_coercion_list( @_ ),
	);
	$new->coercion->freeze;
	return $new;
} #/ sub plus_fallback_coercions

sub minus_coercions {
	my $self = shift;

	my $new = $self->_clone;
	my @not = grep Types::TypeTiny::is_TypeTiny( $_ ),
		$self->_process_coercion_list( $new, @_ );

	my @keep;
	my $c = $self->coercion->type_coercion_map;
	for ( my $i = 0 ; $i <= $#$c ; $i += 2 ) {
		my $keep_this = 1;
		NOT: for my $n ( @not ) {
			if ( $c->[$i] == $n ) {
				$keep_this = 0;
				last NOT;
			}
		}

		push @keep, $c->[$i], $c->[ $i + 1 ] if $keep_this;
	} #/ for ( my $i = 0 ; $i <=...)

	$new->coercion->add_type_coercions( @keep );
	$new->coercion->freeze;
	return $new;
} #/ sub minus_coercions

sub no_coercions {
	my $new = shift->_clone;
	$new->coercion->freeze;
	$new;
}

sub coercibles {
	my $self = shift;
	$self->has_coercion ? $self->coercion->_source_type_union : $self;
}

sub isa {
	my $self = shift;

	if ( $INC{"Moose.pm"}
		and ref( $self )
		and $_[0] =~ /^(?:Class::MOP|MooseX?::Meta)::(.+)$/ )
	{
		my $meta = $1;

		return !!1                       if $meta eq 'TypeConstraint';
		return $self->is_parameterized   if $meta eq 'TypeConstraint::Parameterized';
		return $self->is_parameterizable if $meta eq 'TypeConstraint::Parameterizable';
		return $self->isa( 'Type::Tiny::Union' ) if $meta eq 'TypeConstraint::Union';

		my $inflate = $self->moose_type;
		return $inflate->isa( @_ );
	} #/ if ( $INC{"Moose.pm"} ...)

	if ( $INC{"Mouse.pm"}
		and ref( $self )
		and $_[0] eq 'Mouse::Meta::TypeConstraint' )
	{
		return !!1;
	}

	$self->SUPER::isa( @_ );
} #/ sub isa

sub _build_my_methods {
	return {};
}

sub _lookup_my_method {
	my $self = shift;
	my ( $name ) = @_;

	if ( $self->my_methods->{$name} ) {
		return $self->my_methods->{$name};
	}

	if ( $self->has_parent ) {
		return $self->parent->_lookup_my_method( @_ );
	}

	return;
} #/ sub _lookup_my_method

my %object_methods = (
	with_attribute_values => 1, stringifies_to => 1,
	numifies_to           => 1
);

sub can {
	my $self = shift;

	return !!0
		if $_[0] eq 'type_parameter'
		&& blessed( $_[0] )
		&& $_[0]->has_parameters;

	my $can = $self->SUPER::can( @_ );
	return $can if $can;

	if ( ref( $self ) ) {
		if ( $INC{"Moose.pm"} ) {
			my $method = $self->moose_type->can( @_ );
			return sub { shift->moose_type->$method( @_ ) }
				if $method;
		}
		if ( $_[0] =~ /\Amy_(.+)\z/ ) {
			my $method = $self->_lookup_my_method( $1 );
			return $method if $method;
		}
		if ( $self->{is_object} && $object_methods{ $_[0] } ) {
			require Type::Tiny::ConstrainedObject;
			return Type::Tiny::ConstrainedObject->can( $_[0] );
		}
		for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) {
			if ( $_[0] eq $util ) {
				$self->{'_util'}{$util} ||= eval { $self->_build_util( $util ) };
				return unless $self->{'_util'}{$util};
				return sub { my $s = shift; $s->{'_util'}{$util}( @_ ) };
			}
		}
	} #/ if ( ref( $self ) )

	return;
} #/ sub can

sub AUTOLOAD {
	my $self = shift;
	my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ );
	return if $m eq 'DESTROY';

	if ( ref( $self ) ) {
		if ( $INC{"Moose.pm"} ) {
			my $method = $self->moose_type->can( $m );
			return $self->moose_type->$method( @_ ) if $method;
		}
		if ( $m =~ /\Amy_(.+)\z/ ) {
			my $method = $self->_lookup_my_method( $1 );
			return &$method( $self, @_ ) if $method;
		}
		if ( $self->{is_object} && $object_methods{$m} ) {
			require Type::Tiny::ConstrainedObject;
			unshift @_, $self;
			no strict 'refs';
			goto \&{"Type::Tiny::ConstrainedObject::$m"};
		}
		for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) {
			if ( $m eq $util ) {
				return ( $self->{'_util'}{$util} ||= $self->_build_util( $util ) )->( @_ );
			}
		}
	} #/ if ( ref( $self ) )

	_croak q[Can't locate object method "%s" via package "%s"], $m,
		ref( $self ) || $self;
} #/ sub AUTOLOAD

sub DOES {
	my $self = shift;

	return !!1
		if ref( $self )
		&& $_[0] =~ m{^ Type::API::Constraint (?: ::Coercible | ::Inlinable )? $}x;
	return !!1 if !ref( $self ) && $_[0] eq 'Type::API::Constraint::Constructor';

	"UNIVERSAL"->can( "DOES" ) ? $self->SUPER::DOES( @_ ) : $self->isa( @_ );
} #/ sub DOES

sub _has_xsub {
	require B;
	!!B::svref_2object( shift->compiled_check )->XSUB;
}

sub _build_util {
	my ( $self, $func ) = @_;
	Scalar::Util::weaken( my $type = $self );

	if ( $func eq 'grep'
		|| $func eq 'first'
		|| $func eq 'any'
		|| $func eq 'all'
		|| $func eq 'assert_any'
		|| $func eq 'assert_all' )
	{
		my ( $inline, $compiled );

		if ( $self->can_be_inlined ) {
			$inline = $self->inline_check( '$_' );
		}
		else {
			$compiled = $self->compiled_check;
			$inline   = '$compiled->($_)';
		}

		if ( $func eq 'grep' ) {
			return eval "sub { grep { $inline } \@_ }";
		}
		elsif ( $func eq 'first' ) {
			return eval "sub { for (\@_) { return \$_ if ($inline) }; undef; }";
		}
		elsif ( $func eq 'any' ) {
			return eval "sub { for (\@_) { return !!1 if ($inline) }; !!0; }";
		}
		elsif ( $func eq 'assert_any' ) {
			my $qname = B::perlstring( $self->name );
			return
				eval
				"sub { for (\@_) { return \@_ if ($inline) }; Type::Tiny::_failed_check(\$type, $qname, \@_ ? \$_[-1] : undef); }";
		}
		elsif ( $func eq 'all' ) {
			return eval "sub { for (\@_) { return !!0 unless ($inline) }; !!1; }";
		}
		elsif ( $func eq 'assert_all' ) {
			my $qname = B::perlstring( $self->name );
			return
				eval
				"sub { my \$idx = 0; for (\@_) { Type::Tiny::_failed_check(\$type, $qname, \$_, varname => sprintf('\$_[%d]', \$idx)) unless ($inline); ++\$idx }; \@_; }";
		}
	} #/ if ( $func eq 'grep' ||...)

	if ( $func eq 'map' ) {
		my ( $inline, $compiled );
		my $c = $self->_assert_coercion;

		if ( $c->can_be_inlined ) {
			$inline = $c->inline_coercion( '$_' );
		}
		else {
			$compiled = $c->compiled_coercion;
			$inline   = '$compiled->($_)';
		}

		return eval "sub { map { $inline } \@_ }";
	} #/ if ( $func eq 'map' )

	if ( $func eq 'sort' || $func eq 'rsort' ) {
		my ( $inline, $compiled );

		my $ptype = $self->find_parent( sub { $_->has_sorter } );
		_croak "No sorter for this type constraint" unless $ptype;

		my $sorter = $ptype->sorter;

		# Schwarzian transformation
		if ( ref( $sorter ) eq 'ARRAY' ) {
			my $sort_key;
			( $sorter, $sort_key ) = @$sorter;

			if ( $func eq 'sort' ) {
				return
					eval
					"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$a->[1],\$b->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }";
			}
			elsif ( $func eq 'rsort' ) {
				return
					eval
					"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$b->[1],\$a->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }";
			}
		} #/ if ( ref( $sorter ) eq...)

		# Simple sort
		else {
			if ( $func eq 'sort' ) {
				return eval "our (\$a, \$b); sub { sort { \$sorter->(\$a,\$b) } \@_ }";
			}
			elsif ( $func eq 'rsort' ) {
				return eval "our (\$a, \$b); sub { sort { \$sorter->(\$b,\$a) } \@_ }";
			}
		}
	} #/ if ( $func eq 'sort' ||...)

	die "Unknown function: $func";
} #/ sub _build_util

sub of    { shift->parameterize( @_ ) }
sub where { shift->create_child_type( constraint => @_ ) }

# fill out Moose-compatible API
sub inline_environment        { +{} }
sub _inline_check             { shift->inline_check( @_ ) }
sub _compiled_type_constraint { shift->compiled_check( @_ ) }
sub meta { _croak( "Not really a Moose::Meta::TypeConstraint. Sorry!" ) }
sub compile_type_constraint           { shift->compiled_check }
sub _actually_compile_type_constraint { shift->_build_compiled_check }
sub hand_optimized_type_constraint { shift->{hand_optimized_type_constraint} }

sub has_hand_optimized_type_constraint {
	exists( shift->{hand_optimized_type_constraint} );
}
sub type_parameter { ( shift->parameters || [] )->[0] }

sub parameterized_from {
	$_[0]->is_parameterized ? shift->parent : _croak( "Not a parameterized type" );
}
sub has_parameterized_from { $_[0]->is_parameterized }

# some stuff for Mouse-compatible API
sub __is_parameterized      { shift->is_parameterized( @_ ) }
sub _add_type_coercions     { shift->coercion->add_type_coercions( @_ ) }
sub _as_string              { shift->qualified_name( @_ ) }
sub _compiled_type_coercion { shift->coercion->compiled_coercion( @_ ) }
sub _identity               { Scalar::Util::refaddr( shift ) }

sub _unite {
	require Type::Tiny::Union;
	"Type::Tiny::Union"->new( type_constraints => \@_ );
}

# Hooks for Type::Tie
sub TIESCALAR {
	require Type::Tie;
	unshift @_, 'Type::Tie::SCALAR';
	goto \&Type::Tie::SCALAR::TIESCALAR;
}

sub TIEARRAY {
	require Type::Tie;
	unshift @_, 'Type::Tie::ARRAY';
	goto \&Type::Tie::ARRAY::TIEARRAY;
}

sub TIEHASH {
	require Type::Tie;
	unshift @_, 'Type::Tie::HASH';
	goto \&Type::Tie::HASH::TIEHASH;
}

1;

__END__