Skip to content

Commit

Permalink
cleanups
Browse files Browse the repository at this point in the history
  • Loading branch information
@doy
doy committed Oct 17, 2013
1 parent 8ac86c5 commit 19faa93
Show file tree
Hide file tree
Showing 5 changed files with 140 additions and 212 deletions.
91 changes: 40 additions & 51 deletions lib/mop/attribute.pm
View file
Expand Up @@ -4,17 +4,27 @@ use v5.16;
use warnings;

use Scalar::Util qw[ weaken isweak ];
use mop::internals::util;

our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';

use parent 'mop::object', 'mop::internals::observable';

mop::internals::util::init_attribute_storage(my %name);
mop::internals::util::init_attribute_storage(my %original_id);
mop::internals::util::init_attribute_storage(my %default);
mop::internals::util::init_attribute_storage(my %storage);
mop::internals::util::init_attribute_storage(my %associated_meta);
mop::internals::util::init_attribute_storage(my %original_id);
mop::internals::util::init_attribute_storage(my %storage);

sub name { ${ $name{ $_[0] } // \undef } }
sub associated_meta { ${ $associated_meta{ $_[0] } // \undef } }

sub set_associated_meta {
my ($self, $meta) = @_;
$associated_meta{ $self } = \$meta;
weaken(${ $associated_meta{ $self } });
}

# temporary, for bootstrapping
sub new {
Expand Down Expand Up @@ -54,14 +64,13 @@ sub clone {
);
}

sub name { ${ $name{ $_[0] } } }

sub key_name {
my $self = shift;
substr( $self->name, 2, length $self->name )
}

sub has_default { defined( ${ $default{ $_[0] } } ) }

sub set_default {
my $self = shift;
my ($value) = @_;
Expand All @@ -70,7 +79,9 @@ sub set_default {
}
$default{ $self } = \$value
}

sub clear_default { ${ delete $default{ $_[0] } } }

sub get_default {
my $self = shift;
my $value = ${ $default{ $self } };
Expand All @@ -80,14 +91,8 @@ sub get_default {
$value
}

sub associated_meta { ${ $associated_meta{ $_[0] } // \undef } }
sub set_associated_meta {
my ($self, $meta) = @_;
$associated_meta{ $self } = \$meta;
weaken(${ $associated_meta{ $self } });
}

sub conflicts_with { ${ $original_id{ $_[0] } } ne ${ $original_id{ $_[1] } } }

sub locally_defined { ${ $original_id{ $_[0] } } eq mop::id( $_[0] ) }

sub has_data_in_slot_for {
Expand Down Expand Up @@ -130,66 +135,59 @@ sub is_data_in_slot_weak_for {
}

sub __INIT_METACLASS__ {
state $METACLASS;
return $METACLASS if defined $METACLASS;
require mop::class;
$METACLASS = mop::class->new(
my $METACLASS = mop::class->new(
name => 'mop::attribute',
version => $VERSION,
authority => $AUTHORITY,
superclass => 'mop::object'
superclass => 'mop::object',
);

$METACLASS->add_attribute(mop::attribute->new(
name => '$!name',
storage => \%name
storage => \%name,
));
$METACLASS->add_attribute(mop::attribute->new(
name => '$!default',
storage => \%default,
));
$METACLASS->add_attribute(mop::attribute->new(
name => '$!associated_meta',
storage => \%associated_meta,
));

$METACLASS->add_attribute(mop::attribute->new(
name => '$!original_id',
storage => \%original_id,
default => sub { mop::id($_) },
));

$METACLASS->add_attribute(mop::attribute->new(
name => '$!default',
storage => \%default
));

$METACLASS->add_attribute(mop::attribute->new(
name => '$!storage',
storage => \%storage,
default => sub { mop::internals::util::init_attribute_storage(my %x) },
));

$METACLASS->add_attribute(mop::attribute->new(
name => '$!associated_meta',
storage => \%associated_meta
));

$METACLASS->add_method( mop::method->new( name => 'BUILD', body => \&BUILD ) );

$METACLASS->add_method( mop::method->new( name => 'name', body => \&name ) );
$METACLASS->add_method( mop::method->new( name => 'key_name', body => \&key_name ) );

$METACLASS->add_method( mop::method->new( name => 'has_default', body => \&has_default ) );
$METACLASS->add_method( mop::method->new( name => 'get_default', body => \&get_default ) );
$METACLASS->add_method( mop::method->new( name => 'set_default', body => \&set_default ) );
$METACLASS->add_method( mop::method->new( name => 'clear_default', body => \&clear_default ) );
$METACLASS->add_method( mop::method->new( name => 'name', body => \&name ) );
$METACLASS->add_method( mop::method->new( name => 'key_name', body => \&key_name ) );

$METACLASS->add_method( mop::method->new( name => 'storage', body => \&storage ) );
$METACLASS->add_method( mop::method->new( name => 'has_default', body => \&has_default ) );
$METACLASS->add_method( mop::method->new( name => 'get_default', body => \&get_default ) );
$METACLASS->add_method( mop::method->new( name => 'set_default', body => \&set_default ) );
$METACLASS->add_method( mop::method->new( name => 'clear_default', body => \&clear_default ) );

$METACLASS->add_method( mop::method->new( name => 'associated_meta', body => \&associated_meta ) );
$METACLASS->add_method( mop::method->new( name => 'set_associated_meta', body => \&set_associated_meta ) );
$METACLASS->add_method( mop::method->new( name => 'conflicts_with', body => \&conflicts_with ) );
$METACLASS->add_method( mop::method->new( name => 'locally_defined', body => \&locally_defined ) );

$METACLASS->add_method( mop::method->new( name => 'has_data_in_slot_for', body => \&has_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'conflicts_with', body => \&conflicts_with ) );
$METACLASS->add_method( mop::method->new( name => 'locally_defined', body => \&locally_defined ) );

$METACLASS->add_method( mop::method->new( name => 'has_data_in_slot_for', body => \&has_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'fetch_data_in_slot_for', body => \&fetch_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'store_data_in_slot_for', body => \&store_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'store_default_in_slot_for', body => \&store_default_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'weaken_data_in_slot_for', body => \&weaken_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'weaken_data_in_slot_for', body => \&weaken_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'is_data_in_slot_weak_for', body => \&is_data_in_slot_weak_for ) );

$METACLASS;
}

Expand All @@ -213,8 +211,6 @@ TODO
=item C<BUILD>
=item C<clone(%overrides)>
=item C<name>
=item C<key_name>
Expand All @@ -227,8 +223,6 @@ TODO
=item C<clear_default>
=item C<storage>
=item C<associated_meta>
=item C<set_associated_meta($meta)>
Expand Down Expand Up @@ -280,11 +274,6 @@ the same terms as the Perl 5 programming language system itself.
=for Pod::Coverage
new
clone
=cut
68 changes: 25 additions & 43 deletions lib/mop/class.pm
View file
Expand Up @@ -10,10 +10,17 @@ our $AUTHORITY = 'cpan:STEVAN';

use parent 'mop::role';

mop::internals::util::init_attribute_storage(my %is_abstract);
mop::internals::util::init_attribute_storage(my %superclass);
mop::internals::util::init_attribute_storage(my %is_abstract);
mop::internals::util::init_attribute_storage(my %instance_generator);

sub superclass { ${ $superclass{ $_[0] } // \undef } }
sub is_abstract { ${ $is_abstract{ $_[0] } // \undef } }
sub instance_generator { ${ $instance_generator{ $_[0] } // \undef } }

sub make_class_abstract { $is_abstract{ $_[0] } = \1 }
sub set_instance_generator { $instance_generator{ $_[0] } = \$_[1] }

# temporary, for bootstrapping
sub new {
my $class = shift;
Expand Down Expand Up @@ -52,15 +59,7 @@ sub BUILD {
}
}

# identity

sub superclass { ${ $superclass{ $_[0] } // \undef } }

sub is_abstract { ${ $is_abstract{ $_[0] } } }

sub make_class_abstract { $is_abstract{ $_[0] } = \1 }

# instance creation
sub create_fresh_instance_structure { (shift)->instance_generator->() }

sub new_instance {
my $self = shift;
Expand Down Expand Up @@ -120,35 +119,23 @@ sub clone_instance {
return $clone;
}

sub instance_generator { ${ $instance_generator{ $_[0] } } }
sub set_instance_generator { $instance_generator{ $_[0] } = \$_[1] }

sub create_fresh_instance_structure { (shift)->instance_generator->() }

# events

sub __INIT_METACLASS__ {
state $METACLASS;
return $METACLASS if defined $METACLASS;
require mop::class;
$METACLASS = mop::class->new(
my $METACLASS = mop::class->new(
name => 'mop::class',
version => $VERSION,
authority => $AUTHORITY,
superclass => 'mop::object'
superclass => 'mop::object',
);

$METACLASS->add_attribute(mop::attribute->new(
name => '$!superclass',
storage => \%superclass,
));
$METACLASS->add_attribute(mop::attribute->new(
name => '$!is_abstract',
storage => \%is_abstract,
default => 0,
));

$METACLASS->add_attribute(mop::attribute->new(
name => '$!superclass',
storage => \%superclass
));

$METACLASS->add_attribute(mop::attribute->new(
name => '$!instance_generator',
storage => \%instance_generator,
Expand All @@ -157,18 +144,18 @@ sub __INIT_METACLASS__ {

$METACLASS->add_method( mop::method->new( name => 'BUILD', body => \&BUILD ) );


$METACLASS->add_method( mop::method->new( name => 'superclass', body => \&superclass ) );

$METACLASS->add_method( mop::method->new( name => 'is_abstract', body => \&is_abstract ) );
$METACLASS->add_method( mop::method->new( name => 'is_abstract', body => \&is_abstract ) );
$METACLASS->add_method( mop::method->new( name => 'make_class_abstract', body => \&make_class_abstract ) );

$METACLASS->add_method( mop::method->new( name => 'new_instance', body => \&new_instance ) );
$METACLASS->add_method( mop::method->new( name => 'clone_instance', body => \&clone_instance ) );
$METACLASS->add_method( mop::method->new( name => 'instance_generator', body => \&instance_generator ) );
$METACLASS->add_method( mop::method->new( name => 'set_instance_generator', body => \&set_instance_generator ) );
$METACLASS->add_method( mop::method->new( name => 'instance_generator', body => \&instance_generator ) );
$METACLASS->add_method( mop::method->new( name => 'set_instance_generator', body => \&set_instance_generator ) );
$METACLASS->add_method( mop::method->new( name => 'create_fresh_instance_structure', body => \&create_fresh_instance_structure ) );

$METACLASS->add_method( mop::method->new( name => 'new_instance', body => \&new_instance ) );
$METACLASS->add_method( mop::method->new( name => 'clone_instance', body => \&clone_instance ) );

$METACLASS;
}

Expand Down Expand Up @@ -198,16 +185,16 @@ TODO
=item C<make_class_abstract>
=item C<new_instance(%args)>
=item C<clone_instance($instance, %args)>
=item C<instance_generator>
=item C<set_instance_generator($generator)>
=item C<create_fresh_instance_structure>
=item C<new_instance(%args)>
=item C<clone_instance($instance, %args)>
=back
=head1 SEE ALSO
Expand Down Expand Up @@ -241,8 +228,3 @@ the same terms as the Perl 5 programming language system itself.
new
=cut

0 comments on commit 19faa93

Please sign in to comment.