Root object

    The root object is an ancestor of every object, and thus defines
    behavior common to all objects.

    Public methods (non-overridable):

        name()                          Get name (non-overridable)
        owners()                        Get owners      
        is_owned_by(obj)                True if obj owns this
        public()                        True if object is public
        fertile()                       True if object is fertile
        parents()                       Returns parents of this
        children()                      Returns children of this
        ancestors()                     Returns ancestors of this
        is(obj)                         True if obj is this or an ancestor
        follows(protocol)               True if obj follows protocol
        is_agent(protocol)              True if obj is agent of protocol

    Owner methods:

        set_name(name)                  Sets object name
        set_public(val)                 Sets whether an object is public
        set_fertile(val)                Sets whether an object is fertile
        set_owners(owners)              Specify new set of owners
        add_owner(obj)                  Adds an owner
        del_owner(obj)                  Removes an owner
        add_parent(obj)                 Adds a parent
        del_parent(obj)                 Removes a parent
        destroy()                       Destroys this
        compile(code, name)             Compiles a method onto this
        add_parameter(name)             Adds a parameter
        del_parameter()                 Removes a parameter
        del_method(name)                Removes a method

    Restricted to owners for non-fertile objects:

        spawn([args])                   Spawns a child

    Restricted to owners for non-public objects:

        parameters()                    Returns parameters
        methods()                       Returns method names
        find_method(name)               Finds method definer
        find_next_method(name, after)   Finds next method definer
        list_method(name)               Returns method definition
        show()                          Returns an object listing

object root

var root name "Root object"
var root owners [$root]
var root public 1
var root child_index 0
var root fertile 0
var root inited 0

method initialize
    if (!caller().is_agent('hierarchy) && sender() != this())
	throw(~perm, "Caller is not this or an agent of hierarchy protocol.");
    if (!inited) {
	(> .init(ancestors()) <);
	inited = 1;
    }
.

method deinitialize
    if (!caller().is_agent('hierarchy))
	throw(~perm, "Caller is not an agent of hierarchy protocol.");
    (> .deinit(ancestors()) <);
.

method init
    arg ancestors;
    var prime_parent;

    if (!caller().is_agent('hierarchy))
	throw(~perm, "Caller is not an agent of hierarchy protocol.");
    if (definer() in ancestors) {
        child_index = 0;
        name = "_unnamed_" + tostr(this());
        owners = setadd([this()], sender());
        fertile = 0;

        // Inherit public, fertile from parent.
        prime_parent = parents()[1];
        public = prime_parent.public();
    }
.

method name
    disallow_overrides;

    return name;
.

method owners
    disallow_overrides;

    return owners;
.

method is_owned_by
    disallow_overrides;
    arg obj;

    return obj in owners || $sys.is_admin(obj);
.

method public
    disallow_overrides;

    return public;
.

method fertile
    disallow_overrides;

    return fertile;
.

method set_fertile
    arg val;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender not an owner");
    fertile = val ? 1 | 0;
.

method set_name
    arg s;

    // Only accept calls from owners or admins.
    if (!.is_owned_by(sender()))
        throw(~perm, "Sender not an owner.");

    // Make sure first argument is a string.
    if (type(s) != 'string)
        throw(~type, "First argument (" + toliteral(s) + ") not a string.");

    // Don't allow names beginning with "_unnamed_".
    if (strlen(s) >= 9 && substr(s, 1, 9) == "_unnamed_")
        throw(~name, "Invalid name.");

    // Set name to first argument.
    name = s;
.

method set_public
    arg val;

    // Only accept calls from owners or admins.
    if (!.is_owned_by(sender()))
        throw(~perm, "Sender is not an owner.");

    // Set public to the given value.
    public = val;
.

method set_owners
    arg owners_arg;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender is not an owner.");
    owners = owners_arg;
.

method add_owner
    arg obj;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender is not an owner.");
    owners = setadd(owners, obj);
.

method del_owner
    arg obj;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender is not an owner.");
    owners = setremove(owners, obj);
.

method chparents
    arg parents;
    var old, init, uninit, i;

    if (!.is_owned_by(sender()))
	throw(~perm, "Sender is not an owner.");
    old = ancestors();
    (> $sys.change_sender_parents(parents) <);
    init = [];
    uninit = old;
    for i in (ancestors()) {
	uninit = setremove(uninit, i);
	if (!(i in old))
	    init = init + [i];
    }
    catch any {
        .init(init);
    } with handler {
        (| .uninit(init) |);
        $sys.change_sender_parents_back(old);
        return;
    }
    (| .uninit(uninit) |);
.

method ok_to_inherit
    arg obj;

    // This method is called by the system object to determine if it is okay
    // for an object to inherit from us.
    return (fertile || .is_owned_by(obj));
.

method spawn
    arg name;

    if (!fertile && !.is_owned_by(sender()))
        throw(~perm, "Not fertile and sender not an owner.");

    // Ask the system object for a child.
    child_index = child_index + 1;
    return $sys.spawn_sender(child_index, sender(), name);
.

method destroy
    // This doesn't actually destroy us immediately, but we will go away when
    // nothing is holding onto us any more.
    if (!.is_owned_by(sender()))
        throw(~perm, "Sender not an owner.");
    (| .uninitialize() |);
    $sys.destroy_sender();
.

method add_parameter
    arg name;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender is not an owner.");
    (> add_parameter(name) <);
.

method parameters
    if (!public && !.is_owned_by(sender()))
        throw(~perm, "Not public and sender not an owner.");
    return parameters();
.

method del_parameter
    arg name;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender not an owner.");
    (> del_parameter(name) <);
.

method del_method
    arg name;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender not an owner.");
    (> del_method(name) <);
.

method methods
    if (!public && !.is_owned_by(sender()))
        throw(~perm, "Not public and sender not an owner.");
    return methods();
.

method parents
    disallow_overrides;

    return parents();
.

method children
    disallow_overrides;

    return children();
.

method ancestors
    disallow_overrides;

    return ancestors();
.

method is
    disallow_overrides;
    arg obj;

    return (obj == this() || obj in ancestors());
.

method find_method
    arg name;

    if (!public && !.is_owned_by(sender()))
        throw(~perm, "Not public and sender not an owner.");
    return (> find_method(name) <);
.

method find_next_method
    arg name, after;

    if (!public && !.is_owned_by(sender()))
        throw(~perm, "Not public and sender not an owner.");
    return (> find_next_method(name, after) <);
.

method list_method
    arg name;

    if (!public && !.is_owned_by(sender()))
        throw(~perm, "Not public and sender not an owner.");
    return (> list_method(name) <);
.

method compile
    arg code, name;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender not an owner.");
    return compile(code, name);
.

method show
    var output, i, data, obj, vars;

    if (!public && !.is_owned_by(sender()))
        throw(~perm, "Not public and sender not an owner.");

    // Show parents.
    output = ["Parents: " + toliteral(parents())];

    // Show parameter names.
    output = output + ["Parameters:"];
    for i in (parameters())
        output = output + ["  " + tostr(i)];

    // Show method names.
    output = output + ["Methods:"];
    for i in (methods())
        output = output + ["  " + tostr(i)];

    // Show variables.
    data = $sys.sender_data();
    for obj in (ancestors()) {
        vars = (| data[obj] |);
        if (!vars)
            continue;
        output = output + [toliteral(obj) + " variables:"];
        for i in (dict_keys(vars))
            output = output + ["  " + tostr(i) + ": " + toliteral(vars[i])];
    }

    // Return what we've shown.
    return output;
.

method follows
    disallow_overrides;
    arg protocol;
    var obj;

    for obj in ($sys.followers(protocol)) {
        if (has_ancestor(obj))
            return 1;
    }
    return 0;
.

method is_agent
    disallow_overrides;
    arg protocol;

    return (| this() in $sys.agents(protocol) |) ? 1 | 0;
.

method eval
    arg code;
    var errors, result;

    if (!.is_owned_by(sender()))
        throw(~perm, "Sender doesn't own this.");

    // Compile the code.
    errors = compile(code, 'tmp_eval);
    if (errors)
        return ['errors, errors];

    // Evaluate the expression.  Be sure to remove it afterwards, so that no
    // one else can call it.
    catch any {
        result = .tmp_eval();
    } with handler {
        del_method('tmp_eval);
        rethrow(~methoderr);
    }
    del_method('tmp_eval);
    return ['result, result];
.

eval
    .add_verb("@list * on %this", 'list_verb, 'remote);
    .add_verb("@show %this", 'show_verb, 'remote);
    .add_verb("@params %this", 'params_verb, 'remote);
    .add_verb("@methods %this", 'methods_verb, 'remote);
    .add_verb("@verbs %this", 'verbs_verb, 'remote);
.