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

    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
var root owners [$root]
var root public 1
var root child_index 0
var root fertile 0
var root inited 0

method init_root
    if (caller() != $root)
        throw(~perm, "Caller is not $root.");
    child_index = 0;
    owners = setadd([this()], sender());
    fertile = 0;

    // name has been set by system object prior to initialization.
    // Inherit public from parent.
    public = parents()[1].public();
.

method initialize
    disallow_overrides;
    var ancestors, ancestor, method_name, pos;

    if (caller() != $sys && sender() != this())
        throw(~perm, "Caller is not $sys and sender is not this.");
    if (inited)
        throw(~perm, "Already initialized.");
    ancestors = ancestors();
    for pos in [0 .. listlen(ancestors) - 1] {
        ancestor = ancestors[listlen(ancestors) - pos];
        method_name = tosym("init_" + tostr(ancestor.name()));
        catch ~methodnf {
            if (find_method(method_name) != ancestor)
                throw(~perm, "Initialization method in wrong place.");
            .(method_name)();
        }
    }
    inited = 1;
.

method uninitialize
    disallow_overrides;
    var ancestor;

    if (caller() != $root)
        throw(~perm, "Caller is not $root.");
    for ancestor in (ancestors())
        (| .(tosym("uninit_" + tostr(ancestor.name())))() |);
.

method change_parents
    disallow_overrides;
    arg parents;
    var old, init, uninit, ancestor, pos;

    if (caller() != $root)
        throw(~perm, "Caller is not $root.");

    // Perform the actual change.
    old = ancestors();
    (> $sys.change_sender_parents(parents) <);

    // Figure out new ancestors to initialize, and old ones to uninitialize.
    init = [];
    uninit = old;
    for ancestor in (ancestors()) {
        uninit = setremove(uninit, ancestor);
        if (!(ancestor in old))
            init = [@init, ancestor];
    }

    // Initialize the new ancestors.
    catch any {
        for ancestor in (init) {
            catch ~methodnf {
                .(tosym("init_" + tostr(ancestor.name())))();
            }
        }
    } with handler {
        // Initialization error; deinitialize parents we initialized, and fall
        // back to old parents.
        pos = ancestor in init;
        for ancestor in (sublist(init, 1, pos))
            (| .(tosym("uninit_" + tostr(ancestor.name())))() |);
        $sys.change_sender_parents(old);
        throw(~init, "Failed to initialize new ancestors.");
    }

    // Uninitialize the old ancestors.
    $sys.change_sender_parents(old);
    for ancestor in (uninit)
        (| .(tosym("uninit_" + tostr(ancestor.name())))() |);
    $sys.change_sender_parents(parents);
.

method chparents
    arg parents;
    var parent;

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

    // Notify parents of impending change.
    for parent in (parents)
        (> parent.will_inherit(sender()) <);

    // Everything's okay, go ahead and try it.
    .change_parents(parents);
.

method will_inherit
    arg obj;

    // Throw an error if it's not okay for obj to inherit from us.
    if (!fertile && !.is_owned_by(obj) && !obj.has_ancestor(this()))
        throw(~perm, "Refuse to be parent of prospective child.");
.

method name
    disallow_overrides;

    return name;
.

method name_str
    disallow_overrides;

    return "$" + substr(toliteral(name), 2);
.

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 new_name;
    var old_name;

    // 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(new_name) != 'symbol)
        throw(~type, "New name is not a symbol.");

    // Do nothing if new name isn't different.
    if (new_name == name)
        return;

    // Grab the new name.
    (> $sys.assign_name(new_name) <);
    old_name = name;
    name = new_name;

    // If we already had a name, get rid of the old one.
    if (old_name)
        $sys.deassign_name(old_name);
.

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 spawn
    arg [suffix];
    var obj;

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

    // Figure out the suffix from the arguments and child index.
    if (suffix) {
        if (suffix[1] in "0123456789")
            throw(~perm, "Can't specify a numeric suffix.");
        suffix = suffix[1];
    } else {
        child_index = child_index + 1;
        suffix = tostr(child_index);
    }

    // Ask the system object for a child.
    obj = $sys.spawn_sender(suffix, sender());
    return obj;
.

method destroy
    disallow_overrides;

    // 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 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 has_ancestor
    disallow_overrides;
    arg obj;

    return has_ancestor(obj);
.

method eval
    disallow_overrides;
    arg code, [dest];
    var errors, result;

    dest = dest ? dest[1] | this();

    // Make sure permissions check lets admins in.
    if (!($sys.is_admin(sender()) || sender() in owners))
        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 = dest.tmp_eval();
    } with handler {
        del_method('tmp_eval);
        rethrow(~methoderr);
    }
    del_method('tmp_eval);
    return ['result, result];
.