Changeset 6094 for perl5/Perl6-MetaModel/lib/Perl6/Class.pm

Timestamp:

08/06/05 23:00:58 (3 years ago)

Author:

Stevan

Message:

Perl6::MetaModel? - (p5)
* $?CLASS now returns the ::Class object
* all methods and attributes are now associated with the ::Class object

instead of just the class name

* improved the name of ::get_obj_id to ::get_P6opaque_instance_id so that

no one will try to use it :P

* also added ::get_P6opaque_instance_class to peek into the class slot

(needed this for submethods)

Files:

• perl5/Perl6-MetaModel/lib/Perl6/Class.pm (modified) (10 diffs)

perl5/Perl6-MetaModel/lib/Perl6/Class.pm

@@ -45 +45 @@
 
 sub _apply_class_to_environment {
-    my ($self) = @_;
+    my ($self) = @_;    
     my ($name) = $self->{instance_data}->{name};
     # create the package ...
@@ -53 +53 @@
         \$$name\:\:META = undef;
         1;
-    |;
+    |;    
     eval $code || confess "Could not initialize class '$name'";   
+    _create_metaclass($self);    
+    _build_class($self);     
     # alias the full name ...
     eval {  
@@ -61 +63 @@
     };
     confess "Could not create full name " . $self->{instance_data}->{identifier} . " : $@" if $@;   
-    _build_class($self); 
 }
 
@@ -93 +94 @@
 }
 
-sub _build_class {
+sub _create_metaclass {
     my ($self) = @_;
-    
     my ($name, $version, $authority) = ($self->{instance_data}->{name}, $self->{instance_data}->{version}, $self->{instance_data}->{authority});    
 
@@ -129 +129 @@
         $self->{instance_data}->{meta} = $meta; 
     };
-    confess "Could not initialize the metaclass for $name : $@" if $@; 
+    confess "Could not initialize the metaclass for $name : $@" if $@;     
+}
+
+sub _build_class {
+    my ($self) = @_;
+
+    my $meta = $self->{instance_data}->{meta};
 
     my $superclasses = $self->{instance_data}->{params}->{is};
@@ -136 +142 @@
     if (my $instance = $self->{instance_data}->{params}->{instance}) {
 
-        ::dispatch($meta, 'add_method', ('BUILD' => Perl6::Method->create_submethod($name => $instance->{BUILD})))
+        ::dispatch($meta, 'add_method', ('BUILD' => Perl6::Method->create_submethod($self => $instance->{BUILD})))
             if exists $instance->{BUILD};            
-        ::dispatch($meta, 'add_method', ('DESTROY' => Perl6::Method->create_submethod($name => $instance->{DESTROY})))
+        ::dispatch($meta, 'add_method', ('DESTROY' => Perl6::Method->create_submethod($self => $instance->{DESTROY})))
             if exists $instance->{DESTROY};
             
@@ -144 +150 @@
             foreach (keys %{$instance->{methods}}) {
                 if (/^_/) {
-                    ::dispatch($meta, 'add_method', ($_ => Perl6::Method->create_private_method($name, $instance->{methods}->{$_})));
+                    ::dispatch($meta, 'add_method', ($_ => Perl6::Method->create_private_method($self, $instance->{methods}->{$_})));
                 }
                 else {
-                    ::dispatch($meta, 'add_method', ($_ => Perl6::Method->create_instance_method($name, $instance->{methods}->{$_})));
+                    ::dispatch($meta, 'add_method', ($_ => Perl6::Method->create_instance_method($self, $instance->{methods}->{$_})));
                 }
             }
         }
         if (exists $instance->{submethods}) {
-            ::dispatch($meta, 'add_method', ($_ => Perl6::Method->create_submethod($name, $instance->{submethods}->{$_})))
+            ::dispatch($meta, 'add_method', ($_ => Perl6::Method->create_submethod($self, $instance->{submethods}->{$_})))
                 foreach keys %{$instance->{submethods}};
         }        
@@ -162 +168 @@
                 }
                 ::dispatch($meta, 'add_attribute', (
-                    $attr => Perl6::Instance::Attribute->new($name => $attr, $props)
+                    $attr => Perl6::Instance::Attribute->new($self => $attr, $props)
                 ));              
             }
@@ -176 +182 @@
                 }
                 ::dispatch($meta, 'add_attribute', (
-                    $attr => Perl6::Class::Attribute->new($name => $attr, $props)
+                    $attr => Perl6::Class::Attribute->new($self => $attr, $props)
                 ));
             }            
@@ -184 +190 @@
             foreach my $label (keys %{$class->{methods}}) {
                 if ($label =~ /^_/) {
-                    ::dispatch($meta, 'add_method', ($label => Perl6::Method->create_private_method($name, $class->{methods}->{$label})));
+                    ::dispatch($meta, 'add_method', ($label => Perl6::Method->create_private_method($self, $class->{methods}->{$label})));
                 }
                 else {
-                    ::dispatch($meta, 'add_method', ($label => Perl6::Method->create_class_method($name, $class->{methods}->{$label})));
+                    ::dispatch($meta, 'add_method', ($label => Perl6::Method->create_class_method($self, $class->{methods}->{$label})));
                 }
             }