The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
## ------------------------------------------------------------------------- ##
## Bootstrapping
## ------------------------------------------------------------------------- ##

^Class.set_superclasses([ ^Module ]);

# NOTE:
# this attribute needs to be added manually to the
# class instances since ^Class would have inherited 
# it, but couldn't since they had not yet been defined. 

-> $class {
    $class`set_attr('%!namespace', {}); 
}`do_for([ ^Class, ^Object, ^Module, ^Package ]);

# ... now we can name and version all our objects 
# which has the side effect of creating the name, 
# version and authority slots in our classes, if we
# do not do this, then we need to add $!name, $!version
# and $!authority to the list above along with %!namespace


^Class.set_name('Class');     ^Class.set_version('0.0.1');   ^Class.set_authority('url:pugscode.org');
^Object.set_name('Object');   ^Object.set_version('0.0.1');  ^Object.set_authority('url:pugscode.org');
^Package.set_name('Package'); ^Package.set_version('0.0.1'); ^Package.set_authority('url:pugscode.org');
^Module.set_name('Module');   ^Module.set_version('0.0.1');  ^Module.set_authority('url:pugscode.org');

# Class now needs to implement the FETCH and STORE of Packages

# NOTE:
# With FETCH, we first look in the class's method and attribute
# namespaces, if we don't find anything there, we then just
# search the normal ^Package namespace. If nothing is found
# this will just return nil. I think that this is probably 
# sufficient for our needs, but it may need improvement as we 
# discover how and when this is really used.

# NOTE:
# it is expected that methods are FETCH-ed using a & prefix 

^Class.add_method('FETCH', -> $label {
    $label`fetch(0)`eq('&')`if_else(
        # fetching possible method ...
        -> {
            # we splice off the & to get the method name
            self.has_method($label`splice(1))`if_else(
                -> { self.get_method($label`splice(1)) },
                -> { 
                    # make sure it's not also in the private method
                    # namespace either ...
                    self.has_private_method($label`splice(1))`if_else(
                        -> { self.get_private_method($label`splice(1))  },
                        -> { self`get_attr('%!namespace')`fetch($label) }
                    );
                }
            );
        },
        # fetching attribute
        -> { 
            self.has_attribute($label)`if_else(
                # if we have the attribute, return it
                -> { self.get_attribute($label) },
                -> { self`get_attr('%!namespace')`fetch($label) }
            );
        }
    );
});

# NOTE:
# With STORE we first see if the class has a method or attribute
# of the same name as the one we are storing, if so, then we 
# overwrite it. If there is not, then we STORE into the Package
# namespace normally. This is surely not an ideal situation, and
# will probably need to be fixed once we have a proper ^Method
# and ^Sub types, at which point we can make a more intelligent
# descision as to what to do with the value being stored. But for
# now, this is sufficient.

^Class.add_method('STORE', -> $label, $value {
    $label`fetch(0)`eq('&')`if_else(
        # fetching possible method
        -> {
            # we splice off the & to get the method name
            self.has_method($label`splice(1))`if_else(
                -> { self.add_method($label`splice(1), $value) },
                -> { 
                    # check the private methods too ... 
                    self.has_private_method($label`splice(1))`if_else(                
                        -> { self.add_private_method($label`splice(1), $value) },
                        -> { self`set_attr_hash('%!namespace', $label, $value) }
                    );
                }
            );
        },
        # fetching attribute
        -> { 
            self.has_attribute($label)`if_else(
                # if we have the attribute, return it
                -> { self.set_attribute($label, $value) },
                -> { self`set_attr_hash('%!namespace', $label, $value) }
            );
        }
    );    
});

## end bootstrapping ...
## ------------------------------------------------------------------------- ##