Started to make type checks inlineable - Just done a couple of basic types so far...

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 0a5f76e..fc2766f 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -44,6 +44,13 @@ __PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => (
     predicate => 'has_hand_optimized_type_constraint',
 ));
 
+
+__PACKAGE__->meta->add_attribute('hand_optimized_inline_type_constraint' => (
+    init_arg  => 'inline_optimized',
+    accessor  => 'hand_optimized_inline_type_constraint',
+    predicate => 'has_hand_optimized_inline_type_constraint',
+));
+
 sub parents {
     my $self;
     $self->parent;
@@ -189,6 +196,9 @@ sub _actually_compile_type_constraint {
     return $self->_compile_hand_optimized_type_constraint
         if $self->has_hand_optimized_type_constraint;
 
+    return $self->_compile_hand_optimized_inline_type_constraint
+        if $self->has_hand_optimized_inline_type_constraint;
+
     my $check = $self->constraint;
     unless ( defined $check ) {
         require Moose;
@@ -217,6 +227,32 @@ sub _compile_hand_optimized_type_constraint {
     return $type_constraint;
 }
 
+sub _compile_hand_optimized_inline_type_constraint {
+    my $self = shift;
+
+    my $inline_type_constraint = $self->hand_optimized_inline_type_constraint;
+    local $@;
+    my $type_constraint = $self->_eval_in_emptyish_lexical_scope("sub { $inline_type_constraint }");
+
+    if ($@) {
+        require Moose;
+        Carp::confess ("Hand optimized inline type constraint for", $self->name, "does not compile: $@");
+        Moose->throw_error("Hand optimized inline type constrant does not compile");
+    }
+
+    unless ( ref $type_constraint ) {
+        require Moose;
+        Carp::confess ("Hand optimized type constraint for " . $self->name . " is not a code reference");
+        Moose->throw_error("Hand optimized type constraint is not a code reference");
+    }
+
+    return $type_constraint;
+}
+
+sub _eval_in_emptyish_lexical_scope {
+    eval $_[1];
+}
+
 sub _compile_subtype {
     my ($self, $check) = @_;
 
@@ -298,6 +334,27 @@ sub create_child_type {
     return $class->new(%opts, parent => $self);
 }
 
+sub is_null {
+    my ($self) = @_;
+    $self->_compiled_type_constraint == $null_constraint;
+}
+
+
+sub inline_check_of {
+    my ($self, $value_var, $constraint_var) = @_;
+    $constraint_var ||= '$constraint';
+    $value_var      ||= '$_';
+    if ($self->has_hand_optimized_type_constraint) {
+        return 'do { local @_ = ('
+            . $value_var
+            . ');'
+            . $self->hand_optimized_inline_type_constraint
+            . '}';
+    }
+    else {
+        return "$constraint_var->check($value_var)";
+    }
+}
 1;
 
 __END__
@@ -462,6 +519,17 @@ provided C<%options>. The C<parent> option will be the current type.
 This method exists so that subclasses of this class can override this
 behavior and change how child types are created.
 
+=item B<< $constraint->inline_check_of($value_var?, $constraint_var?) >>
+
+This returns a string which, if evalled, would check the value in
+C<$value_var> via a constraint in C<$constraint_var>. For convenience,
+C<$value_var> defaults to C<'$_'> and C<$constraint_var> defaults to
+C<'$constraint'>.
+
+=item B<< $constraint->is_null >>
+
+Returns true if the constraint's check is the null check.
+
 =back
 
 =head1 BUGS

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 9fe4cf2..0698322 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -399,6 +399,7 @@ sub as { { as => shift }, @_ }
 sub where (&)       { { where       => $_[0] } }
 sub message (&)     { { message     => $_[0] } }
 sub optimize_as (&) { { optimize_as => $_[0] } }
+sub inline_as       { { optimize_as => $_[0] } }
 
 sub from    {@_}
 sub via (&) { $_[0] }
@@ -516,7 +517,11 @@ sub _create_type_constraint ($$$;$$) {
 
         ( $check     ? ( constraint => $check )     : () ),
         ( $message   ? ( message    => $message )   : () ),
-        ( $optimized ? ( optimized  => $optimized ) : () ),
+        ( $optimized
+              ? ref($optimized)
+                  ? ( optimized  => $optimized )
+                  : ( inline_optimized => $optimized )
+              : () ),
     );
 
     my $constraint;
@@ -657,17 +662,17 @@ subtype 'Bool' => as 'Item' =>
     where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
 
 subtype 'Value' => as 'Defined' => where { !ref($_) } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value;
+    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineValue();
 
 subtype 'Ref' => as 'Defined' => where { ref($_) } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
+    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineRef;
 
 subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
+    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineStr;
 
 subtype 'Num' => as 'Str' =>
     where { Scalar::Util::looks_like_number($_) } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
+    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineNum;
 
 subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } =>
     optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int;
@@ -1123,6 +1128,16 @@ B<NOTE:> You should only use this if you know what you are doing,
 all the built in types use this, so your subtypes (assuming they
 are shallow) will not likely need to use this.
 
+=item B<inline_as { ... }>
+
+This can also be used to define a hand optimized version of the
+type constraint which can be inlined by modules like
+L<MooseX::Method::Signatures>. Don't attempt to use this as well
+as C<optimize_as> or you may die.
+
+B<NOTE:> As with C<optimize_as>, only use this if you know what
+you're doing.
+
 =item B<< type 'Name' => where { } ... >>
 
 This creates a base type, which has no parent.

diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
index 17a8868..ab88d82 100644 (file)
--- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
@@ -10,18 +10,22 @@ our $VERSION   = '1.01';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
-sub Value { defined($_[0]) && !ref($_[0]) }
 
-sub Ref { ref($_[0]) }
+sub InlineValue {
+    'defined($_[0]) && !ref($_[0])';
+}
+sub InlineRef { 'ref($_[0])' }
 
 # We need to use a temporary here to flatten LVALUEs, for instance as in
 # Str(substr($_,0,255)).
-sub Str {
-    my $value = $_[0];
-    defined($value) && ref(\$value) eq 'SCALAR'
+sub InlineStr {
+    q{my $value = $_[0];}
+        . q{defined($value) && ref(\$value) eq 'SCALAR'}
 }
 
-sub Num { !ref($_[0]) && looks_like_number($_[0]) }
+sub InlineNum {
+    q{!ref($_[0]) && Scalar::Util::looks_like_number($_[0])}
+}
 
 sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }
 
@@ -72,13 +76,13 @@ no user serviceable parts inside.
 
 =over 4
 
-=item C<Value>
+=item C<InlineValue>
 
-=item C<Ref>
+=item C<InlineRef>
 
-=item C<Str>
+=item C<InlineStr>
 
-=item C<Num>
+=item C<InlineNum>
 
 =item C<Int>