You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2011/01/23 01:14:18 UTC

[lucy-commits] svn commit: r1062298 - in /incubator/lucy/trunk/clownfish/lib/Clownfish: Type.pm Type/Arbitrary.pm Type/Composite.pm Type/Integer.pm Type/Object.pm Type/Primitive.pm

Author: marvin
Date: Sun Jan 23 00:14:17 2011
New Revision: 1062298

URL: http://svn.apache.org/viewvc?rev=1062298&view=rev
Log:
Change Clownfish::Type to an inside-out object implementation.

Modified:
    incubator/lucy/trunk/clownfish/lib/Clownfish/Type.pm
    incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Arbitrary.pm
    incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Composite.pm
    incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Integer.pm
    incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Object.pm
    incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Primitive.pm

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Type.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Type.pm?rev=1062298&r1=1062297&r2=1062298&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Type.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Type.pm Sun Jan 23 00:14:17 2011
@@ -22,6 +22,14 @@ use Clownfish::Util qw( verify_args );
 use Scalar::Util qw( blessed );
 use Carp;
 
+# Inside-out member vars.
+our %const;
+our %specifier;
+our %indirection;
+our %parcel;
+our %c_string;
+our %nullable;
+
 our %new_PARAMS = (
     const       => undef,
     specifier   => undef,
@@ -31,27 +39,50 @@ our %new_PARAMS = (
 );
 
 sub new {
-    my $either = shift;
+    my ( $either, %args ) = @_;
     my $package = ref($either) || $either;
     confess( __PACKAGE__ . "is an abstract class" )
         if $package eq __PACKAGE__;
-    verify_args( \%new_PARAMS, @_ ) or confess $@;
-    my $self = bless { %new_PARAMS, @_, }, $package;
-    if ( defined $self->get_parcel ) {
-        if ( !blessed( $self->get_parcel ) ) {
-            $self->{parcel}
-                = Clownfish::Parcel->singleton( name => $self->get_parcel );
+    verify_args( \%new_PARAMS, %args ) or confess $@;
+    my $blank = '';
+    my $self = bless \$blank, $package;
+
+    my $parcel = $args{parcel};
+    if ( defined $parcel ) {
+        if ( !blessed($parcel) ) {
+            $parcel = Clownfish::Parcel->singleton( name => $parcel );
         }
         confess("Not a Clownfish::Parcel")
-            unless $self->get_parcel->isa('Clownfish::Parcel');
+            unless $parcel->isa('Clownfish::Parcel');
     }
+    $parcel{$self} = $parcel;
+
+    $const{$self}       = $args{const};
+    $specifier{$self}   = $args{specifier};
+    $indirection{$self} = $args{indirection};
+    $c_string{$self}    = $args{c_string};
+
     return $self;
 }
 
-sub get_specifier { shift->{specifier} }
-sub get_parcel    { shift->{parcel} }
-sub const         { shift->{const} }
-sub nullable      { shift->{nullable} }
+sub DESTROY {
+    my $self = shift;
+    delete $parcel{$self};
+    delete $const{$self};
+    delete $specifier{$self};
+    delete $indirection{$self};
+    delete $c_string{$self};
+    delete $nullable{$self};
+}
+
+sub get_specifier   { $specifier{ +shift } }
+sub get_parcel      { $parcel{ +shift } }
+sub get_indirection { $indirection{ +shift } }
+sub const           { $const{ +shift } }
+sub nullable        { $nullable{ +shift } }
+
+sub set_specifier { $specifier{ $_[0] } = $_[1] }
+sub set_nullable  { $nullable{ $_[0] }  = $_[1] }
 
 sub is_object      {0}
 sub is_primitive   {0}
@@ -68,8 +99,8 @@ sub equals {
     return 1;
 }
 
-sub to_c { shift->{c_string} }
-sub set_c_string { $_[0]->{c_string} = $_[1] }
+sub to_c { $c_string{ +shift } }
+sub set_c_string { $c_string{ $_[0] } = $_[1] }
 
 1;
 
@@ -140,7 +171,7 @@ Return the C representation of the type.
 
 Set the C representation of the type.
 
-=head2 get_specifier get_parcel const nullable
+=head2 get_specifier get_parcel get_indirection const nullable set_specifier set_nullable
 
 Accessors.
 

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Arbitrary.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Arbitrary.pm?rev=1062298&r1=1062297&r2=1062298&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Arbitrary.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Arbitrary.pm Sun Jan 23 00:14:17 2011
@@ -40,8 +40,10 @@ sub new {
     if ( $specifier =~ /^[A-Z]/ and $parcel ) {
         my $prefix = $parcel->get_prefix;
         # Add $prefix to what appear to be namespaced types.
-        $specifier = $self->{specifier} = $prefix . $specifier
-            unless $specifier =~ /^$prefix/;
+        if ( $specifier !~ /^$prefix/ ) {
+            $specifier = $prefix . $specifier;
+            $self->set_specifier($specifier);
+        }
     }
 
     # Cache C representation.

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Composite.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Composite.pm?rev=1062298&r1=1062297&r2=1062298&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Composite.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Composite.pm Sun Jan 23 00:14:17 2011
@@ -22,6 +22,10 @@ use Clownfish::Util qw( verify_args a_is
 use Scalar::Util qw( blessed );
 use Carp;
 
+# Inside-out member vars.
+our %array;
+our %child;
+
 our %new_PARAMS = (
     child       => undef,
     indirection => undef,
@@ -34,21 +38,19 @@ sub new {
     my $array    = delete $args{array};
     my $child    = delete $args{child};
     my $nullable = delete $args{nullable};
+    $args{indirection} ||= 0;
     confess("Missing required param 'child'")
         unless a_isa_b( $child, "Clownfish::Type" );
     verify_args( \%new_PARAMS, %args ) or confess $@;
     my $self = $either->SUPER::new(%args);
-    $self->{child}    = $child;
-    $self->{array}    = $array;
-    $self->{nullable} = $nullable;
-
-    # Default indirection to 0.
-    my $indirection = $self->{indirection} ||= 0;
+    $child{$self} = $child;
+    $array{$self} = $array;
+    $self->set_nullable($nullable);
 
     # Cache C representation.
     # NOTE: Array postfixes are NOT included.
     my $string = $child->to_c;
-    for ( my $i = 0; $i < $indirection; $i++ ) {
+    for ( my $i = 0; $i < $self->get_indirection; $i++ ) {
         $string .= '*';
     }
     $self->set_c_string($string);
@@ -56,15 +58,21 @@ sub new {
     return $self;
 }
 
-sub get_specifier    { shift->_get_child->get_specifier }
-sub get_array        { shift->{array} }
-sub _get_child       { shift->{child} }
-sub _get_indirection { shift->{indirection} }
-sub is_composite     {1}
+sub DESTROY {
+    my $self = shift;
+    delete $array{$self};
+    delete $child{$self};
+    $self->SUPER::DESTROY;
+}
+
+sub get_specifier { shift->_get_child->get_specifier }
+sub get_array     { $array{ +shift } }
+sub _get_child    { $child{ +shift } }
+sub is_composite  {1}
 
 sub equals {
     my ( $self, $other ) = @_;
-    return 0 unless $self->_get_indirection == $other->_get_indirection;
+    return 0 unless $self->get_indirection == $other->get_indirection;
     return 0 unless $self->_get_child->equals( $other->_get_child );
     return 0 if ( $self->get_array xor $other->get_array );
     return 0 if ( $self->get_array and $self->get_array ne $other->get_array );

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Integer.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Integer.pm?rev=1062298&r1=1062297&r2=1062298&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Integer.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Integer.pm Sun Jan 23 00:14:17 2011
@@ -22,6 +22,9 @@ use Clownfish::Util qw( verify_args );
 use Carp;
 use Config;
 
+# Inside-out member vars.
+our %sizeof;
+
 our %new_PARAMS = (
     const     => undef,
     specifier => undef,
@@ -58,12 +61,18 @@ sub new {
     $c_string .= $args{specifier};
 
     my $self = $either->SUPER::new( %args, c_string => $c_string );
-    $self->{sizeof} = $sizeof;
+    $sizeof{$self} = $sizeof;
     return $self;
 }
 
+sub DESTROY {
+    my $self = shift;
+    delete $sizeof{$self};
+    $self->SUPER::DESTROY;
+}
+
 sub is_integer {1}
-sub sizeof     { shift->{sizeof} }
+sub sizeof     { $sizeof{ +shift } }
 
 1;
 

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Object.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Object.pm?rev=1062298&r1=1062297&r2=1062298&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Object.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Object.pm Sun Jan 23 00:14:17 2011
@@ -23,6 +23,11 @@ use Clownfish::Util qw( verify_args );
 use Scalar::Util qw( blessed );
 use Carp;
 
+# Inside-out member vars.
+our %incremented;
+our %decremented;
+our %is_string_type;
+
 our %new_PARAMS = (
     const       => undef,
     specifier   => undef,
@@ -39,14 +44,13 @@ sub new {
     my $incremented = delete $args{incremented} || 0;
     my $decremented = delete $args{decremented} || 0;
     my $nullable    = delete $args{nullable}    || 0;
-    my $indirection = delete $args{indirection};
-    $indirection = 1 unless defined $indirection;
+    $args{indirection} = 1 unless defined $args{indirection};
+    my $indirection = $args{indirection};
     $args{parcel} ||= Clownfish::Parcel->default_parcel;
     my $self = $either->SUPER::new(%args);
-    $self->{incremented} = $incremented;
-    $self->{decremented} = $decremented;
-    $self->{indirection} = $indirection;
-    $self->{nullable}    = $nullable;
+    $incremented{$self} = $incremented;
+    $decremented{$self} = $decremented;
+    $self->set_nullable($nullable);
     my $prefix    = $self->get_parcel->get_prefix;
     my $specifier = $self->get_specifier;
 
@@ -63,7 +67,7 @@ sub new {
     # Add $prefix if necessary.
     if ( $specifier !~ /^$prefix/ ) {
         $specifier = $prefix . $specifier;
-        $self->{specifier} = $specifier;
+        $self->set_specifier($specifier);
     }
 
     # Cache C representation.
@@ -72,22 +76,28 @@ sub new {
     $self->set_c_string($string);
 
     # Cache boolean indicating whether this type is a string type.
-    $self->{is_string_type} = $specifier =~ /CharBuf/ ? 1 : 0;
+    $is_string_type{$self} = $specifier =~ /CharBuf/ ? 1 : 0;
 
     return $self;
 }
 
-sub is_object      {1}
-sub incremented    { shift->{incremented} }
-sub decremented    { shift->{decremented} }
-sub is_string_type { shift->{is_string_type} }
+sub DESTROY {
+    my $self = shift;
+    delete $incremented{$self};
+    delete $decremented{$self};
+    delete $is_string_type{$self};
+    $self->SUPER::DESTROY;
+}
 
-sub set_nullable { $_[0]->{nullable} = $_[1] }
+sub is_object      {1}
+sub incremented    { $incremented{ +shift } }
+sub decremented    { $decremented{ +shift } }
+sub is_string_type { $is_string_type{ +shift } }
 
 sub similar {
     my ( $self, $other ) = @_;
     for (qw( const incremented decremented nullable )) {
-        return 0 if ( $self->{$_} xor $other->{$_} );
+        return 0 if ( $self->$_ xor $other->$_ );
     }
     return 1;
 }

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Primitive.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Primitive.pm?rev=1062298&r1=1062297&r2=1062298&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Primitive.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Type/Primitive.pm Sun Jan 23 00:14:17 2011
@@ -33,7 +33,7 @@ sub new {
     my $package = ref($either) || $either;
     confess( __PACKAGE__ . " is abstract" ) if $package eq __PACKAGE__;
     verify_args( \%new_PARAMS, %args ) or confess $@;
-    return bless { %new_PARAMS, %args }, $package;
+    return $package->SUPER::new( %new_PARAMS, %args );
 }
 
 sub is_primitive {1}