binary

#!/usr/bin/perl
# 99aeabc9ec7fe80b1b39f5e53dc7e49e      <- self-modifying Perl magic
# state:  3adfc957094f35e4175a95ae9f70f55b
# istate: 606dfbfbb1378e9a1c99362e070d2e0d
# id:     93194ecf50e38f2adb6e273909e007b5

# This is a self-modifying Perl file. I'm sorry you're viewing the source (it's
# really gnarly). If you're curious what it's made of, I recommend reading
# https://github.com/spencertipping/writing-self-modifying-perl.
#
# If you got one of these from someone and don't know what to do with it, send
# it to spencer@spencertipping.com and I'll see if I can figure out what it
# does.

# For the benefit of HTML viewers (this is a hack):
# <div id='cover' style='position: absolute; left: 0; top: 0; width: 10000px; height: 10000px; background: white'></div>

$|++;

my %data;
my %transient;
my %externalized_functions;
my %datatypes;

my %locations;          # Maps eval-numbers to attribute names

my $global_data = join '', <DATA>;

sub meta::define_form {
  my ($namespace, $delegate) = @_;
  $datatypes{$namespace} = $delegate;
  *{"meta::${namespace}::implementation"} = $delegate;
  *{"meta::$namespace"} = sub {
    my ($name, $value, %options) = @_;
    chomp $value;
    $data{"${namespace}::$name"} = $value unless $options{no_binding};
    &$delegate($name, $value) unless $options{no_delegate}}}

sub meta::eval_in {
  my ($what, $where) = @_;

  # Obtain next eval-number and alias it to the designated location
  @locations{eval('__FILE__') =~ /\(eval (\d+)\)/} = ($where);

  my $result = eval $what;
  $@ =~ s/\(eval \d+\)/$where/ if $@;
  warn $@ if $@;
  $result}

meta::define_form 'meta', sub {
  my ($name, $value) = @_;
  meta::eval_in($value, "meta::$name")};
meta::meta('configure', <<'__');
# A function to configure transients. Transients can be used to store any number of
# different things, but one of the more common usages is type descriptors.

sub meta::configure {
  my ($datatype, %options) = @_;
  $transient{$_}{$datatype} = $options{$_} for keys %options;
}
__
meta::meta('externalize', <<'__');
# Function externalization. Data types should call this method when defining a function
# that has an external interface.

sub meta::externalize {
  my ($name, $attribute, $implementation) = @_;
  my $escaped = $name;
  $escaped =~ s/[^A-Za-z0-9:]/_/go;
  $externalized_functions{$name} = $externalized_functions{$escaped} = $attribute;
  *{"::$name"} = *{"::$escaped"} = $implementation || $attribute;
}
__
meta::meta('functor::editable', <<'__');
# An editable type. This creates a type whose default action is to open an editor
# on whichever value is mentioned. This can be changed using different flags.

sub meta::functor::editable {
  my ($typename, %options) = @_;

  meta::configure $typename, %options;
  meta::define_form $typename, sub {
    my ($name, $value) = @_;

    $options{on_bind} && &{$options{on_bind}}($name, $value);

    meta::externalize $options{prefix} . $name, "${typename}::$name", sub {
      my $attribute             = "${typename}::$name";
      my ($command, @new_value) = @_;

      return &{$options{default}}(retrieve($attribute)) if ref $options{default} eq 'CODE' and not defined $command;
      return edit($attribute) if $command eq 'edit' or $options{default} eq 'edit' and not defined $command;
      return associate($attribute, @new_value ? join(' ', @new_value) : join('', <STDIN>)) if $command eq '=' or $command eq 'import' or $options{default} eq 'import' and not defined $command;
      return retrieve($attribute)}}}
__
meta::meta('type::alias', <<'__');
meta::configure 'alias', inherit => 0, trim => 1;
meta::define_form 'alias', sub {
  my ($name, $value) = @_;
  meta::externalize $name, "alias::$name", sub {
    # Can't pre-tokenize because shell::tokenize doesn't exist until the library::
    # namespace has been evaluated (which will be after alias::).
    shell::run(shell::tokenize($value), shell::tokenize(@_));
  };
};
__
meta::meta('type::binary', 'meta::functor::editable \'binary\', extension => \'.binary\', default => \'edit\', inherit => 0;');
meta::meta('type::bootstrap', <<'__');
# Bootstrap attributes don't get executed. The reason for this is that because
# they are serialized directly into the header of the file (and later duplicated
# as regular data attributes), they will have already been executed when the
# file is loaded.

meta::configure 'bootstrap', extension => '.pl', inherit => 1, trim => 1;
meta::define_form 'bootstrap', sub {};
__
meta::meta('type::cache', <<'__');
meta::configure 'cache', inherit => 0, trim => 1;
meta::define_form 'cache', \&meta::bootstrap::implementation;
__
meta::meta('type::data', 'meta::functor::editable \'data\', extension => \'\', inherit => 0, default => \'cat\';');
meta::meta('type::function', <<'__');
meta::configure 'function', extension => '.pl', inherit => 1, trim => 1;
meta::define_form 'function', sub {
  my ($name, $value) = @_;
  meta::externalize $name, "function::$name", meta::eval_in("sub {\n$value\n}", "function::$name");
};
__
meta::meta('type::hook', <<'__');
meta::configure 'hook', extension => '.pl', inherit => 0, trim => 1;
meta::define_form 'hook', sub {
  my ($name, $value) = @_;
  *{"hook::$name"} = meta::eval_in("sub {\n$value\n}", "hook::$name");
};
__
meta::meta('type::inc', <<'__');
meta::configure 'inc', inherit => 1, extension => '.pl', trim => 1;
meta::define_form 'inc', sub {
  use File::Path 'mkpath';
  use File::Basename qw/basename dirname/;

  my ($name, $value) = @_;
  my $tmpdir   = basename($0) . '-' . $$;
  my $filename = "/tmp/$tmpdir/$name";

  push @INC, "/tmp/$tmpdir" unless grep /^\/tmp\/$tmpdir$/, @INC;

  mkpath(dirname($filename));
  unless (-e $filename) {
    open my $fh, '>', $filename;
    print $fh $value;
    close $fh;
  }
};
__
meta::meta('type::indicator', <<'__');
# Shell indicator function. The output of each of these is automatically
# appended to the shell prompt.

meta::configure 'indicator', inherit => 1, extension => '.pl', trim => 1;
meta::define_form 'indicator', sub {
  my ($name, $value) = @_;
  *{"indicator::$name"} = meta::eval_in("sub {\n$value\n}", "indicator::$name");
};
__
meta::meta('type::internal_function', <<'__');
meta::configure 'internal_function', extension => '.pl', inherit => 1, trim => 1;
meta::define_form 'internal_function', sub {
  my ($name, $value) = @_;
  *{$name} = meta::eval_in("sub {\n$value\n}", "internal_function::$name");
};
__
meta::meta('type::library', <<'__');
meta::configure 'library', extension => '.pl', inherit => 1, trim => 1;
meta::define_form 'library', sub {
  my ($name, $value) = @_;
  meta::eval_in($value, "library::$name");
};
__
meta::meta('type::message_color', <<'__');
meta::configure 'message_color', extension => '', inherit => 1, trim => 1;
meta::define_form 'message_color', sub {
  my ($name, $value) = @_;
  terminal::color($name, $value);
};
__
meta::meta('type::meta', <<'__');
# This doesn't define a new type. It customizes the existing 'meta' type
# defined in bootstrap::initialization. Note that horrible things will
# happen if you redefine it using the editable functor.

meta::configure 'meta', extension => '.pl', inherit => 1, trim => 1;
__
meta::meta('type::parent', <<'__');
meta::define_form 'parent', \&meta::bootstrap::implementation;
meta::configure 'parent', extension => '', inherit => 1, trim => 1;
__
meta::meta('type::retriever', <<'__');
meta::configure 'retriever', extension => '.pl', inherit => 1, trim => 1;
meta::define_form 'retriever', sub {
  my ($name, $value) = @_;
  $transient{retrievers}{$name} = meta::eval_in("sub {\n$value\n}", "retriever::$name");
};
__
meta::meta('type::state', <<'__');
# Allows temporary or long-term storage of states. Nothing particularly insightful
# is done about compression, so storing alternative states will cause a large
# increase in size. Also, states don't contain other states -- otherwise the size
# increase would be exponential.

# States are created with the save-state function.

meta::configure 'state', inherit => 0, extension => '.pl', trim => 1;
meta::define_form 'state', \&meta::bootstrap::implementation;
__
meta::meta('type::vim_highlighter', <<'__');
# Vim highlighters don't need to be inherited. The reason is that they are most
# often configured from the parent object using the 'vim' function. They are
# rarely sent to anyone else and configured after the fact.

meta::configure 'vim_highlighter', extension => '.vim', inherit => 0;
meta::define_form 'vim_highlighter', \&meta::bootstrap::implementation;
__
meta::bootstrap('html', <<'__');
<html>
  <head>
  <meta http-equiv='content-type' content='text/html; charset=UTF-8' />
  <link rel='stylesheet' href='http://spencertipping.com/perl-objects/web/style.css'/>

  <script src='http://ajax.googleapis.com/ajax/libs/jquery/1.5.2/jquery.min.js'></script>
  <script src='http://spencertipping.com/caterwaul/caterwaul.all.min.js'></script>
  <script src='http://spencertipping.com/montenegro/montenegro.client.js'></script>
  <script src='http://spencertipping.com/perl-objects/web/attribute-parser.js'></script>
  <script src='http://spencertipping.com/perl-objects/web/interface.js'></script>
  </head>
  <body></body>
</html>
__
meta::bootstrap('initialization', <<'__');
#!/usr/bin/perl
# 99aeabc9ec7fe80b1b39f5e53dc7e49e      <- self-modifying Perl magic
# state:  __state
# istate: __istate
# id:     __id

# This is a self-modifying Perl file. I'm sorry you're viewing the source (it's
# really gnarly). If you're curious what it's made of, I recommend reading
# https://github.com/spencertipping/writing-self-modifying-perl.
#
# If you got one of these from someone and don't know what to do with it, send
# it to spencer@spencertipping.com and I'll see if I can figure out what it
# does.

# For the benefit of HTML viewers (this is a hack):
# <div id='cover' style='position: absolute; left: 0; top: 0; width: 10000px; height: 10000px; background: white'></div>

$|++;

my %data;
my %transient;
my %externalized_functions;
my %datatypes;

my %locations;          # Maps eval-numbers to attribute names

my $global_data = join '', <DATA>;

sub meta::define_form {
  my ($namespace, $delegate) = @_;
  $datatypes{$namespace} = $delegate;
  *{"meta::${namespace}::implementation"} = $delegate;
  *{"meta::$namespace"} = sub {
    my ($name, $value, %options) = @_;
    chomp $value;
    $data{"${namespace}::$name"} = $value unless $options{no_binding};
    &$delegate($name, $value) unless $options{no_delegate}}}

sub meta::eval_in {
  my ($what, $where) = @_;

  # Obtain next eval-number and alias it to the designated location
  @locations{eval('__FILE__') =~ /\(eval (\d+)\)/} = ($where);

  my $result = eval $what;
  $@ =~ s/\(eval \d+\)/$where/ if $@;
  warn $@ if $@;
  $result}

meta::define_form 'meta', sub {
  my ($name, $value) = @_;
  meta::eval_in($value, "meta::$name")};
__
meta::bootstrap('perldoc', <<'__');
=head1 Self-modifying Perl script

=head2 Original implementation by Spencer Tipping L<http://spencertipping.com>

The prototype for this script is licensed under the terms of the MIT source code license.
However, this script in particular may be under different licensing terms. To find out how
this script is licensed, please contact whoever sent it to you. Alternatively, you may
run it with the 'license' argument if they have specified a license that way.

You should not edit this file directly. For information about how it was constructed, go
to L<http://spencertipping.com/writing-self-modifying-perl>. For quick usage guidelines,
run this script with the 'usage' argument.

=cut
__
meta::cache('parent-identification', <<'__');
object 99aeabc9ec7fe80b1b39f5e53dc7e49e
vim-highlighters 902333a0bd6ed90ff919fe8477cb4e69
__
meta::cache('parent-state', <<'__');
902333a0bd6ed90ff919fe8477cb4e69 8d4ebdc5d3e901edca2bec5d546d6f7f
99aeabc9ec7fe80b1b39f5e53dc7e49e 13d3013b77dc0268499bab45dad28870
__
meta::data('author', <<'__');
Spencer Tipping <spencer@spencertipping.com>

__
meta::data('default-action', 'shell');
meta::data('license', <<'__');
MIT License
Copyright (c) 2010 Spencer Tipping

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
__
meta::data('permanent-identity', '93194ecf50e38f2adb6e273909e007b5');
meta::function('ad', <<'__');
my ($options, @paths) = separate_options(@_);
@{$transient{path}} = () if $$options{-c};
return @{$transient{path}} = () unless @paths;
push @{$transient{path}}, @paths;
__
meta::function('alias', <<'__');
my ($name, @stuff) = @_;
@_ ? @stuff ? around_hook('alias', @_, sub {associate("alias::$name", join(' ', @stuff), execute => 1)})
            : retrieve("alias::$name") // "Undefined alias $name"
   : table_display([select_keys('--namespace' => 'alias')], [map retrieve($_), select_keys('--namespace' => 'alias')]);
__
meta::function('cat', 'join "\\n", retrieve(@_);');
meta::function('cc', <<'__');
# Stashes a quick one-line continuation. (Used to remind me what I was doing.)
@_ ? associate('data::current-continuation', hook('set-cc', join(' ', @_))) : retrieve('data::current-continuation');
__
meta::function('ccc', 'rm(\'data::current-continuation\');');
meta::function('child', <<'__');
around_hook('child', @_, sub {
  my ($child_name) = @_;
  clone($child_name);
  enable();
  qx($child_name update-from $0);
  terminal::info("$child_name\'s identity is " . join '', qx($child_name identity));
  disable()});
__
meta::function('clone', <<'__');
my ($options, @files) = separate_options(@_);
for my $file (@files) {
  around_hook('clone', $file, sub {
    hypothetically(sub {
      # Assign a new object identity.
      rm('data::permanent-identity');
      identity();

      file::write($file, serialize(), noclobber => 1);
      chmod(0700, $file)})})}
__
meta::function('compile-binary', <<'__');
# Compiles binary-text to binary output. The binary-text is tokenized and then
# compiled, where each token is one of the following:
#
# Literal:
# /[0-9a-f]{2}/         <- single byte in hex
# /o[0-3][0-7]{2}/      <- single byte in octal
# /-[01]{8}/            <- single byte in binary
# /'\S+/                <- bytes in ASCII
#
# Placement (low-level):
# /@![0-9a-f]+/         <- place assertion (die unless next byte is at place)
# /@[0-9a-f]+/          <- place seek (emit null bytes until next byte is place)
# /@\?(\w\+)/           <- debugging: print $1 followed by its location
# /@:[0-9a-f]+/         <- alignment: emit \0 until next byte is multiple of n
#
# Repetition:
# /\/(\d+)\//           <- repeat next byte $1 times
#
# Assembler:
# /::([^' ]\+)/         <- create label $1 pointing to next byte offset
# /:\d*\[([^\]]+)\]/    <- insert bytes resulting from expression evaluation
#
# The assembler gives you a language you can use to evaluate expressions. It's
# ultimately a preprocessor transform to Perl; that is, a few string
# substitutions are made and then Perl evaluates the result, dropping that into
# the generated image. The assembler dies unless the expression's byte size
# matches the number before the open bracket. Here are the preprocessor
# transformations:
#
# s/:</$o/g                             <- offset at beginning of expression
# s/:>/($o + $e{size})/g                <- offset at end of expression
# s/::?([^' ]+)/$places{'$1'}/g         <- label references
# s/L(\d)?(.*)/&$le($1, $2)/g           <- little-endian integer encoding
# s/B(\d)?(.*)/&$be($1, $2)/g           <- big-endian integer encoding
#
# Little-endian and big-endian encoders take a numeric argument indicating how
# many bytes should be encoded. This number is limited only by Perl's numerical
# precision, and by the fact that you have only one digit to specify it. Results
# are sign-extended to the requested byte width. An error occurs if the value
# produces a signed overflow given its width.
#
# You can use 0 width to evaluate an expression with no output; that is, some
# form of side-effect. In this case, the bracketed expression's value is ignored
# and no length check occurs. A shorthand for this case is :[...].
#
# Note that all expressions are evaluated after the basic image has been
# generated. This allows you to use forward references to labels.

my ($options, @stuff) = separate_options(@_);

my $text = join ' ', map split(/\s+/), split /(?:\s|^)#.*/m, cat(@stuff);
my $hex_letters = '0123456789abcdef';

my %places;
my %expressions;
my @output;

my $offset     = 0;
my $next       = 1;
my $repeat     = sub {$next = $_[0]; ''};                       # Repeaters have no output
my $repetition = sub {my $count = $next; $next = 1; $count};
my $ascii      = sub {$_[0]};
my $binary     = sub {my $total = 0; $total = ($total << 1) + substr($_[0], $_, 1)                         for 0 .. 7; chr($total) x &$repetition()};
my $octal      = sub {my $total = 0; $total = ($total << 3) + index($hex_letters,    substr($_[0], $_, 1)) for 0 .. 2; chr($total) x &$repetition()};
my $hex        = sub {my $total = 0; $total = ($total << 4) + index($hex_letters, lc substr($_[0], $_, 1)) for 0 .. 1; chr($total) x &$repetition()};
my $until      = sub {my $address = hex $_[0]; "\0" x ($address - $offset)};
my $align      = sub {my $width = hex $_[0]; "\0" x (($width - $offset % $width) % $width)};
my $debug      = sub {printf STDERR "%s: 0x%x\n", $_[0], $offset; ''};
my $place      = sub {die sprintf "incorrect address at place %x (actual is %x)", hex $_[0], $offset unless $offset == hex $_[0]; ''};
my $label      = sub {die sprintf "label %s is defined twice" if exists $places{$_[0]}; $places{$_[0]} = $offset; ''};
my $expression = sub {push @{$expressions{$offset} ||= []}, {size => $_[0], e => $_[1]}; 'E' x $_[0]};

my $emit       = sub {my ($s) = @_; $offset += length $s; push @output, $s};

my @tokens = split m#('\S+ | -[01]{8} | o[0-3][0-7]{2} | [0-9a-f]{2} | \@\?\S+ |
                      /\d+/ | ::\S+ | :\d*\[[^\]]+\] | \@[!:]?[0-9a-f]+)#x, $text;

&$emit(/^'(\S+)/        ? &$ascii($1)  : /^\@\?(\S+)/        ? &$debug($1) :
       /^-([01]{8})/    ? &$binary($1) : /^o([0-3][0-7]{2})/ ? &$octal($1) :
       /^@!([0-9a-f]+)/ ? &$place($1)  : /^\@([0-9a-f]+)/    ? &$until($1) :
                                         /^\@:([0-9a-f]+)/   ? &$align($1) :
       /^\/(\d+)\//     ? &$repeat($1) : /^[0-9a-f]{2}/      ? &$hex($_)   :

       /^::(\S+)/            ? &$label($1)          :
       /^:(\d*)\[([^\]]+)\]/ ? &$expression($1, $2) : '') for @tokens;

# Now go through and evaluate every expression. Right now the spaces for the
# results contain repetitions of the byte 'E'.
my $concatenated = join '', @output;

my $check_overflow = sub {
  my ($upper, $lower) = ((1 << $_[0] * 8 - 1) - 1, -(1 << $_[0] * 8 - 1));
  die "$_[1] signed-overflows $_[0] bytes ($lower, $upper)"
  unless $_[1] <= $upper and $_[1] >= $lower;
  @_};

my $le = sub {join '', map chr($_[1] >> $_ * 8 & 255),         0 .. $_[0] - 1};
my $be = sub {join '', map chr($_[1] >> $_ * 8 & 255), reverse 0 .. $_[0] - 1};

for my $o (sort {$a <=> $b} keys %expressions) {
  for my $e (@{$expressions{$o}}) {
    my $expression = $$e{e};
    my $size       = $$e{size};

    $_ = $expression;

    s/:</$o/g, s/:>/($o + $size)/g;

    # :: is unchecked, : is checked
    s/::([^' ]+)/\$places{'$1'}/g;
    s-:([^' ]+)-(\$places{'$1'} // die '$1 is not a defined label')-g;

    s/L([1-9])?(.+)/&\$le(&\$check_overflow(($1) || $size, $2))/g;
    s/B([1-9])?(.+)/&\$be(&\$check_overflow(($1) || $size, $2))/g;

    my $result = eval;
    die "error evaluating $_ as $expression: $@" if $@;

    if ($size) {
      die "result of $_ as $expression is " . length($result) .
          " bytes; expected $size"
          if length($result) != $size;

      substr($concatenated, $o, $size) = $result;
    }
  }
}

# Bwoop bwoop bwoop egregious hack alert
$transient{compile_binary_places} = \%places if $$options{'--save-places'};

$concatenated;
__
meta::function('cp', <<'__');
my $from = shift @_;
my $value = retrieve($from);
associate($_, $value) for @_;
__
meta::function('create', <<'__');
my ($name, $value) = @_;
around_hook('create', $name, $value, sub {
  return edit($name) if exists $data{$name};
  associate($name, defined $value ? $value : '');
  edit($name) unless defined $value});
__
meta::function('current-state', 'serialize(\'-pS\');');
meta::function('cwd', <<'__');
use Cwd qw/getcwd/;
getcwd();
__
meta::function('disable', 'hook(\'disable\', chmod_self(sub {$_[0] & 0666}));');
meta::function('edit', <<'__');
my ($options, @names) = separate_options(@_);
@names = select_keys('--criteria' => "^$$options{'--prefix'}.*" . join('.*', @names), %$options) if $$options{'--prefix'};

my ($name, @others) = @names;
die "cannot edit multiple attributes simultaneously (others are @others)" if @others;
die "$name is virtual or does not exist" unless exists $data{$name};
die "$name is inherited; use 'edit $name -f' to edit anyway" unless is($name, '-u') || is($name, '-d') || exists $$options{'-f'};

my $extension = extension_for($name);
around_hook('edit', @_, sub {
  associate($name, invoke_editor_on($data{$name} // '', %$options, attribute => $name, extension => $extension), execute => 1)});

save() unless $data{'data::edit::no-save'} or state() eq $transient{initial};
'';
__
meta::function('edit-self', <<'__');
$global_data = invoke_editor_on($global_data);
save();
__
meta::function('enable', 'hook(\'enable\', chmod_self(sub {$_[0] | $_[0] >> 2}));');
meta::function('expanded-bootstrap', <<'__');
# Write headers into the bootstrap section. There is some subtle stuff going on
# here with the istate header. The idea is to provide other objects a very quick
# way to see whether our state has changed, but we don't want false positives.
# We would get a false positive if, for instance, we included the contents of
# parent:: attributes in the istate hash. The reason is that the parent::
# attribute contains a hash of every attribute provided by that parent, so any
# change in the parent would impact the istate of the child.
#
# The best way to deal with this is to treat parent:: attributes as being
# opaque; we record their existence or nonexistence, but we don't record their
# contents. We also look only at inheritable and unique attributes and fail to
# consider global state.

my $bootstrap_text = retrieve('bootstrap::initialization');
my $state          = state();
my $istate         = state('-iGP');
my $object_id      = identity();

$bootstrap_text =~ s/__state/$state/g;
$bootstrap_text =~ s/__istate/$istate/g;
$bootstrap_text =~ s/__id/$object_id/g;

$bootstrap_text;
__
meta::function('export', <<'__');
# Exports data into a text file.
#   export attr1 attr2 attr3 ... file.txt
my $name = pop @_;
@_ or die 'Expected filename';
file::write($name, join "\n", retrieve(@_));
__
meta::function('extern', '&{$_[0]}(retrieve(@_[1 .. $#_]));');
meta::function('grep', <<'__');
# Looks through attributes for a pattern. Usage is grep pattern [options], where
# [options] is the format as provided to select_keys.

my ($pattern, @args)     = @_;
my ($options, @criteria) = separate_options(@args);
my @attributes           = select_keys(%$options, '--criteria' => join('|', @criteria));

$pattern = qr/$pattern/;

my @m_attributes;
my @m_line_numbers;
my @m_lines;

for my $k (@attributes) {
  next unless length $k;
  my @lines = split /\n/, retrieve($k);
  for (0 .. $#lines) {
    next unless $lines[$_] =~ $pattern;
    push @m_attributes,   $k;
    push @m_line_numbers, $_ + 1;
    push @m_lines,        '' . ($lines[$_] // '')}}

unless ($$options{'-C'}) {
  s/($pattern)/\033[1;31m\1\033[0;0m/g for @m_lines;
  s/^/\033[1;34m/o for @m_attributes;
  s/^/\033[1;32m/o && s/$/\033[0;0m/o for @m_line_numbers}

table_display([@m_attributes], [@m_line_numbers], [@m_lines]);
__
meta::function('hash', 'fast_hash(@_);');
meta::function('hook', <<'__');
my ($hook, @args) = @_;
$transient{active_hooks}{$hook} = 1;
dangerous('', sub {&$_(@args)}) for grep /^hook::${hook}::/, sort keys %data;
@args;
__
meta::function('hooks', 'join "\\n", sort keys %{$transient{active_hooks}};');
meta::function('identity', <<'__');
retrieve('data::permanent-identity') or
associate('data::permanent-identity', fast_hash(join '|', map rand(), 1 .. 32));
__
meta::function('import', <<'__');
my $name = pop @_;
associate($name, @_ ? join('', map(file::read($_), @_)) : join('', <STDIN>));
__
meta::function('initial-state', '$transient{initial};');
meta::function('is', <<'__');
my ($attribute, @criteria) = @_;
my ($options, @stuff) = separate_options(@criteria);
exists $data{$attribute} and attribute_is($attribute, %$options);
__
meta::function('load-state', <<'__');
around_hook('load-state', @_, sub {
  my ($state_name) = @_;
  my $state = retrieve("state::$state_name");

  terminal::state('saving current state into _...');
  save_state('_');

  delete $data{$_} for grep ! /^state::/, keys %data;
  %externalized_functions = ();

  terminal::state("restoring state $state_name...");
  meta::eval_in($state, "state::$state_name");
  terminal::error(hook('load-state-failed', $@)) if $@;
  reload();
  verify()});
__
meta::function('lock', 'hook(\'lock\', chmod_self(sub {$_[0] & 0555}));');
meta::function('ls', <<'__');
my ($options, @criteria) = separate_options(@_);
my ($external, $shadows, $sizes, $flags, $long, $hashes, $parent_hashes) = @$options{qw(-e -s -z -f -l -h -p)};
$sizes = $flags = $hashes = $parent_hashes = 1 if $long;

return table_display([grep ! exists $data{$externalized_functions{$_}}, sort keys %externalized_functions]) if $shadows;

my $criteria    = join('|', @criteria);
my @definitions = select_keys('--criteria' => $criteria, '--path' => $transient{path}, %$options);

my %inverses  = map {$externalized_functions{$_} => $_} keys %externalized_functions;
my @externals = map $inverses{$_}, grep length, @definitions;
my @internals = grep length $inverses{$_}, @definitions;
my @sizes     = map sprintf('%6d %6d', length(serialize_single($_)), length(retrieve($_))), @{$external ? \@internals : \@definitions} if $sizes;

my @flags     = map {my $k = $_; join '', map(is($k, "-$_") ? $_ : '-', qw(d i m u))} @definitions if $flags;
my @hashes    = map fast_hash(retrieve($_)), @definitions if $hashes;

my %inherited     = parent_attributes(grep /^parent::/o, keys %data) if $parent_hashes;
my @parent_hashes = map $inherited{$_} || '-', @definitions if $parent_hashes;

join "\n", map strip($_), split /\n/, table_display($external ? [grep length, @externals] : [@definitions],
                                                    $sizes ? ([@sizes]) : (), $flags ? ([@flags]) : (), $hashes ? ([@hashes]) : (), $parent_hashes ? ([@parent_hashes]) : ());
__
meta::function('metadata-from', <<'__');
my ($filename) = @_;
my %metadata;

# Not using file::read because we only need the first few lines.
open my($fh), '<', $filename or return {};
while (<$fh>) {
  /^#\s*(\w+):\s*(.*)$/ and $metadata{$1} = $2;
  last unless /^#/;
}
close $fh;

\%metadata;
__
meta::function('mv', <<'__');
my ($from, $to) = @_;
die "'$from' does not exist" unless exists $data{$from};
associate($to, retrieve($from), execute => 1);
rm($from);
__
meta::function('name', <<'__');
my $name = $0;
$name =~ s/^.*\///;
$name;
__
meta::function('parents', 'join "\\n", grep s/^parent:://o, sort keys %data;');
meta::function('perl', <<'__');
my @result = eval(join ' ', @_);
$@ ? terminal::error($@) : wantarray ? @result : $result[0];
__
meta::function('rd', <<'__');
if (@_) {my $pattern = join '|', @_;
         @{$transient{path}} = grep $_ !~ /^$pattern$/, @{$transient{path}}}
else    {pop @{$transient{path}}}
__
meta::function('reload', 'around_hook(\'reload\', sub {execute($_) for grep ! /^bootstrap::/, keys %data});');
meta::function('rm', <<'__');
around_hook('rm', @_, sub {
  exists $data{$_} or terminal::warning("$_ does not exist") for @_;
  delete @data{@_}});
__
meta::function('rmparent', <<'__');
# Removes one or more parents.
my ($options, @parents) = separate_options(@_);
my $clobber_divergent = $$options{'-D'} || $$options{'--clobber-divergent'};

my %parents = map {$_ => 1} @parents;
my @other_parents = grep !$parents{$_}, grep s/^parent:://, select_keys('--namespace' => 'parent');
my %kept_by_another_parent;

$kept_by_another_parent{$_} = 1 for grep s/^(\S+)\s.*$/\1/, split /\n/o, cat(@other_parents);

for my $parent (@parents) {
  my $keep_parent_around = 0;

  for my $line (split /\n/, retrieve("parent::$parent")) {
    my ($name, $hash) = split /\s+/, $line;
    next unless exists $data{$name};

    my $local_hash = fast_hash(retrieve($name));
    if ($clobber_divergent or $hash eq $local_hash or ! defined $hash) {rm($name) unless $kept_by_another_parent{$name}}
    else {terminal::info("local attribute $name exists and is divergent; use rmparent -D $parent to delete it");
          $keep_parent_around = 1}}

  $keep_parent_around ? terminal::info("not deleting parent::$parent so that you can run", "rmparent -D $parent if you want to nuke divergent attributes too")
                      : rm("parent::$parent")}
__
meta::function('save', 'around_hook(\'save\', sub {dangerous(\'\', sub {file::write($0, serialize(\'-V\')); $transient{initial} = state()}) if verify()});');
meta::function('save-state', <<'__');
# Creates a named copy of the current state and stores it.
my ($state_name) = @_;
around_hook('save-state', $state_name, sub {
  associate("state::$state_name", current_state(), execute => 1)});
__
meta::function('serialize', <<'__');
my ($options, @criteria) = separate_options(@_);
delete $$options{'-P'};

my $partial     = delete $$options{'-p'};
my $criteria    = join '|', @criteria;
my @attributes  = map serialize_single($_), select_keys(%$options, '-m' => 1, '--criteria' => $criteria), select_keys(%$options, '-M' => 1, '--criteria' => $criteria);
my @final_array = @{$partial ? \@attributes : [expanded_bootstrap(), @attributes, 'internal::main();', '', '__DATA__', $global_data]};
join "\n", @final_array;
__
meta::function('serialize-single', <<'__');
# Serializes a single attribute and optimizes for content.

my $name          = $_[0] || $_;
my $contents      = retrieve_trimmed($name);
my $meta_function = 'meta::' . namespace($name);
my $invocation    = attribute($name);

if ($contents !~ /\v/) {
  $contents =~ s/\\/\\\\/go;
  $contents =~ s/'/\\'/go;
  return "$meta_function('$invocation', '$contents');"}

my $delimiter = '__' . fast_hash($contents);
my $chars     = 2;

++$chars until $chars >= length($delimiter) || index("\n$contents", "\n" . substr($delimiter, 0, $chars)) == -1;
$delimiter = substr($delimiter, 0, $chars);

"$meta_function('$invocation', <<'$delimiter');\n$contents\n$delimiter";
__
meta::function('sh', <<'__');
around_hook('sh', @_, sub {
  system(@_)});
__
meta::function('shb', <<'__');
# Backgrounded shell.
with_fork(@_, \&::sh);
__
meta::function('shell', <<'__');
my ($options, @arguments) = separate_options(@_);
$transient{repl_prefix} = $$options{'--repl-prefix'};

terminal::cc(retrieve('data::current-continuation')) if length $data{'data::current-continuation'};
around_hook('shell', sub {shell::repl(%$options)});
__
meta::function('size', <<'__');
my $size = 0;
$size += length $data{$_} for keys %data;
sprintf "   full logical  unique    self\n% 7d % 7d % 7d % 7d", length(serialize()), $size, length(serialize('-up')), length $global_data;
__
meta::function('snapshot', <<'__');
my ($name) = @_;
file::write(my $finalname = temporary_name($name), serialize(), noclobber => 1);
chmod 0700, $finalname;
hook('snapshot', $finalname);
__
meta::function('snapshot-if-necessary', 'snapshot() if state() ne $transient{initial};');
meta::function('state', <<'__');
my ($options, @attributes) = separate_options(@_);
@attributes = grep !is($_, '-v'), sort keys %data unless @attributes;
@attributes = grep is($_, '-iu'), @attributes if $$options{'-i'};
@attributes = grep is($_, '-P'),  @attributes if $$options{'-P'};

my $hash = fast_hash(fast_hash(scalar @attributes) . join '|', @attributes);
$hash = fast_hash(retrieve_trimmed($_) . "|$hash") for @attributes;

$hash = fast_hash(join '|', $hash, grep s/^parent:://, sort keys %data)
if $$options{'-P'};

$$options{'-G'} ? $hash : fast_hash("$global_data|$hash");
__
meta::function('touch', 'associate($_, \'\') for @_;');
meta::function('unlock', 'hook(\'unlock\', chmod_self(sub {$_[0] | 0200}));');
meta::function('update', 'update_from(@_, grep s/^parent:://o, sort keys %data);');
meta::function('update-from', <<'__');
# Upgrade all attributes that aren't customized. Customization is defined when the data type is created,
# and we determine it here by checking for $transient{inherit}{$type}.

# Note that this assumes you trust the remote script. If you don't, then you shouldn't update from it.

around_hook('update-from-invocation', separate_options(@_), sub {
  my ($options, @targets) = @_;
  my %parent_id_cache    = cache('parent-identification');
  my %parent_state_cache = cache('parent-state');
  my %already_seen;

  @targets or return;

  my @known_targets     = grep s/^parent:://, parent_ordering(map "parent::$_", grep exists $data{"parent::$_"}, @targets);
  my @unknown_targets   = grep ! exists $data{"parent::$_"}, @targets;
  @targets = (@known_targets, @unknown_targets);

  my $save_state        = $$options{'-s'} || $$options{'--save'};
  my $no_state          = $$options{'-S'} || $$options{'--no-state'};
  my $no_verify         = $$options{'-V'} || $$options{'--no-verify'};
  my $no_parents        = $$options{'-P'} || $$options{'--no-parent'} || $$options{'--no-parents'};
  my $force             = $$options{'-f'} || $$options{'--force'};
  my $clobber_divergent = $$options{'-D'} || $$options{'--clobber-divergent'};

  my $can_skip_already_seen = !($$options{'-K'} || $$options{'--no-skip'}) &&
                              !$force && !$clobber_divergent;

  save_state('before-update') unless $no_state;

  for my $target (@targets) {
    dangerous("updating from $target", sub {
    around_hook('update-from', $target, sub {
      my $target_filename = strip(qx(which $target)) || $target;
      my %parent_metadata = %{metadata_from($target_filename)};
      terminal::warning("$target_filename has no externally visible metadata (makes updating slower)") unless $parent_metadata{id};

      my $identity = $parent_id_cache{$target} ||= $parent_metadata{id} || join '', qx($target identity);
      next if $can_skip_already_seen and
              exists $data{"parent::$target"} and
              $already_seen{$identity} || $parent_state_cache{$identity} eq $parent_metadata{istate};

      my $attributes = join '', qx($target ls -ahiu);
      my %divergent;
      die "skipping unreachable $target" unless $attributes;

      # These need to come after the reachability check so that we retry against
      # other copies in case something fails.
      ++$already_seen{$identity};
      $parent_state_cache{$identity} = $parent_metadata{istate} || join '', qx($target state -iPG);

      for my $to_rm (split /\n/, retrieve("parent::$target")) {
        my ($name, $hash) = split(/\s+/, $to_rm);
        next unless exists $data{$name};

        my $local_hash = fast_hash(retrieve($name));
        if ($clobber_divergent or $hash eq $local_hash or ! defined $hash) {rm($name)}
        else {terminal::info("preserving local version of divergent attribute $name (use update -D to clobber it)");
              $divergent{$name} = retrieve($name)}}

      associate("parent::$target", $attributes) unless $no_parents;

      dangerous('', sub {eval qx($target serialize -ipmu)});
      dangerous('', sub {eval qx($target serialize -ipMu)});

      map associate($_, $divergent{$_}), keys %divergent unless $clobber_divergent;

      reload()})})}

  cache('parent-identification', %parent_id_cache);
  cache('parent-state',          %parent_state_cache);

  if ($no_verify) {hook('update-from-presumably-succeeded', $options, @targets);
                   rm('state::before-update') unless $no_state || $save_state}
  elsif (verify()) {hook('update-from-succeeded', $options, @targets);
                    terminal::info("Successfully updated. Run 'load-state before-update' to undo this change.") if $save_state;
                    rm('state::before-update') unless $no_state || $save_state}
  elsif ($force || $no_state) {hook('update-from-failed', $options, @targets);
                               terminal::warning('Failed to verify: at this point your object will not save properly, though backup copies will be created.',
                                                 $no_state ? 'You should attempt to repair this object since no prior state was saved.'
                                                           : 'Run "load-state before-update" to undo the update and return to a working state.')}
  else {hook('update-from-failed', $options, @targets);
        terminal::error('Verification failed after the upgrade was complete.');
        terminal::info("$0 has been reverted to its pre-upgrade state.", "If you want to upgrade and keep the failure state, then run 'update-from $target --force'.");
        load_state('before-update');
        rm('state::before-update')}});
__
meta::function('usage', '"Usage: $0 action [arguments]\\nUnique actions (run \'$0 ls\' to see all actions):" . ls(\'-u\');');
meta::function('verify', <<'__');
file::write(my $other = $transient{temporary_filename} = temporary_name(), my $serialized_data = serialize());
chomp(my $observed = join '', qx|perl '$other' state|);

unlink $other if my $result = $observed eq (my $state = state());
terminal::error("Verification failed; expected $state but got $observed from $other") unless $result;
hook('after-verify', $result, observed => $observed, expected => $state);
$result;
__
meta::function('vim', <<'__');
# Installs VIM highlighters.
file::write("$ENV{'HOME'}/.vim/syntax/$_.vim", retrieve("vim_highlighter::$_")) for grep s/^vim_highlighter:://o, keys %data;
__
meta::indicator('cc', 'length ::retrieve(\'data::current-continuation\') ? "\\033[1;36mcc\\033[0;0m" : \'\';');
meta::indicator('locked', 'is_locked() ? "\\033[1;31mlocked\\033[0;0m" : \'\';');
meta::indicator('path', <<'__');
my @highlighted = map join("\033[1;30m|\033[0;0m", split /\|/, $_), @{$transient{path}};
join "\033[1;30m/\033[0;0m", @highlighted;
__
meta::internal_function('around_hook', <<'__');
# around_hook('hookname', @args, sub {
#   stuff;
# });

# Invokes 'before-hookname' on @args before the sub runs, invokes the
# sub on @args, then invokes 'after-hookname' on @args afterwards.
# The after-hook is not invoked if the sub calls 'die' or otherwise
# unwinds the stack.

my $hook = shift @_;
my $f    = pop @_;

hook("before-$hook", @_);
my @result = &$f(@_);
hook("after-$hook", @_, @result);
wantarray ? @result : $result[0];
__
meta::internal_function('associate', <<'__');
my ($name, $value, %options) = @_;
die "Namespace does not exist" unless exists $datatypes{namespace($name)};
$data{$name} = $value;
execute($name) if $options{execute};
$value;
__
meta::internal_function('attribute', <<'__');
my ($name) = @_;
$name =~ s/^[^:]*:://;
$name;
__
meta::internal_function('attribute_is', <<'__');
my ($a, %options) = @_;
my %inherited     = parent_attributes(grep /^parent::/o, sort keys %data) if grep exists $options{$_}, qw/-u -U -d -D/;
my $criteria      = $options{'--criteria'} || $options{'--namespace'} && "^$options{'--namespace'}::" || '.';

my %tests = ('-u' => sub {! $inherited{$a}},
             '-d' => sub {$inherited{$a} && fast_hash(retrieve($a)) ne $inherited{$a}},
             '-i' => sub {$transient{inherit}{namespace($a)}},
             '-v' => sub {$transient{virtual}{namespace($a)}},
             '-p' => sub {$a =~ /^parent::/o},
             '-s' => sub {$a =~ /^state::/o},
             '-m' => sub {$a =~ /^meta::/o});

return 0 unless scalar keys %tests == scalar grep ! exists $options{$_}    ||   &{$tests{$_}}(), keys %tests;
return 0 unless scalar keys %tests == scalar grep ! exists $options{uc $_} || ! &{$tests{$_}}(), keys %tests;

$a =~ /$_/ || return 0 for @{$options{'--path'}};
$a =~ /$criteria/;
__
meta::internal_function('cache', <<'__');
my ($name, %pairs) = @_;
if (%pairs) {associate("cache::$name", join "\n", map {$pairs{$_} =~ s/\n//g; "$_ $pairs{$_}"} sort keys %pairs)}
else        {map split(/\s/, $_, 2), split /\n/, retrieve("cache::$name")}
__
meta::internal_function('chmod_self', <<'__');
my ($mode_function)      = @_;
my (undef, undef, $mode) = stat $0;
chmod &$mode_function($mode), $0;
__
meta::internal_function('dangerous', <<'__');
# Wraps a computation that may produce an error.
my ($message, $computation) = @_;
terminal::info($message) if $message;
my @result = eval {&$computation()};
terminal::warning(translate_backtrace($@)), return undef if $@;
wantarray ? @result : $result[0];
__
meta::internal_function('debug_trace', <<'__');
terminal::debug(join ', ', @_);
wantarray ? @_ : $_[0];
__
meta::internal_function('execute', <<'__');
my ($name, %options) = @_;
my $namespace = namespace($name);
eval {&{$datatypes{$namespace}}(attribute($name), retrieve($name))};
warn $@ if $@ && $options{'carp'};
__
meta::internal_function('exported', <<'__');
# Allocates a temporary file containing the concatenation of attributes you specify,
# and returns the filename. The filename will be safe for deletion anytime.
my $filename = temporary_name();
file::write($filename, cat(@_));
$filename;
__
meta::internal_function('extension_for', <<'__');
my $extension = $transient{extension}{namespace($_[0])};
$extension = &$extension($_[0]) if ref $extension eq 'CODE';
$extension || '';
__
meta::internal_function('fast_hash', <<'__');
my ($data)     = @_;
my $piece_size = length($data) >> 3;

my @pieces     = (substr($data, $piece_size * 8) . length($data), map(substr($data, $piece_size * $_, $piece_size), 0 .. 7));
my @hashes     = (fnv_hash($pieces[0]));

push @hashes, fnv_hash($pieces[$_ + 1] . $hashes[$_]) for 0 .. 7;

$hashes[$_] ^= $hashes[$_ + 4] >> 16 | ($hashes[$_ + 4] & 0xffff) << 16 for 0 .. 3;
$hashes[0]  ^= $hashes[8];

sprintf '%08x' x 4, @hashes[0 .. 3];
__
meta::internal_function('file::read', <<'__');
my $name = shift;
open my($handle), "<", $name;
my $result = join "", <$handle>;
close $handle;
$result;
__
meta::internal_function('file::write', <<'__');
use File::Path     'mkpath';
use File::Basename 'dirname';

my ($name, $contents, %options) = @_;
die "Choosing not to overwrite file $name" if $options{noclobber} and -f $name;
mkpath(dirname($name)) if $options{mkpath};

my $open_name = $name =~ /^[>|]/ ? $name : $options{append} ? ">> $name" : "> $name";
open my($handle), $open_name or die "Can't open $name for writing";
print $handle $contents;
close $handle;
__
meta::internal_function('fnv_hash', <<'__');
# A rough approximation to the Fowler-No Voll hash. It's been 32-bit vectorized
# for efficiency, which may compromise its effectiveness for short strings.

my ($data) = @_;

my ($fnv_prime, $fnv_offset) = (16777619, 2166136261);
my $hash                     = $fnv_offset;
my $modulus                  = 2 ** 32;

$hash = ($hash ^ ($_ & 0xffff) ^ ($_ >> 16)) * $fnv_prime % $modulus for unpack 'L*', $data . substr($data, -4) x 8;
$hash;
__
meta::internal_function('hypothetically', <<'__');
# Allows you to make changes to the data without committing them.
# Usage:
#
# hypothetically(sub {
#   ...
# });
#
# Changes to %data made inside the sub {} are discarded.

my %data_backup   = %data;
my ($side_effect) = @_;
my @result        = eval {&$side_effect()};
%data = %data_backup;

die $@ if $@;
wantarray ? @result : $result[0];
__
meta::internal_function('internal::main', <<'__');
disable();

$SIG{'INT'}              = sub {snapshot_if_necessary(); exit 1};
$transient{initial}      = state();
chomp(my $default_action = retrieve('data::default-action'));

my $function_name = shift(@ARGV) || $default_action;
my @effective_argv = @ARGV;

unshift @effective_argv, $function_name and $function_name = 'method_missing'
unless exists $externalized_functions{$function_name};

around_hook('main-function', $function_name, @effective_argv, sub {
  dangerous('', sub {
    chomp(my @result = &$function_name(@effective_argv));
    print join("\n", @result), "\n" if @result})});

save() unless state() eq $transient{initial};

END {enable()}
__
meta::internal_function('invoke_editor_on', <<'__');
my ($data, %options) = @_;
my $editor    = $options{editor} || $ENV{VISUAL} || $ENV{EDITOR} || die 'Either the $VISUAL or $EDITOR environment variable should be set to a valid editor';
my $options   = $options{options} || $ENV{VISUAL_OPTS} || $ENV{EDITOR_OPTS} || '';
my $attribute = $options{attribute};
$attribute =~ s/\//-/g;
my $filename  = temporary_name() . "-$attribute$options{extension}";

file::write($filename, $data);
system("$editor $options '$filename'");

my $result = file::read($filename);
unlink $filename;
$result;
__
meta::internal_function('is_locked', '!((stat($0))[2] & 0222);');
meta::internal_function('namespace', <<'__');
my ($name) = @_;
$name =~ s/::.*$//;
$name;
__
meta::internal_function('parent_attributes', <<'__');
my $attributes = sub {my ($name, $value) = split /\s+/o, $_; $name => ($value || 1)};
map &$attributes(), split /\n/o, join("\n", retrieve(@_));
__
meta::internal_function('parent_ordering', <<'__');
# Topsorts the parents by dependency chain. The simplest way to do this is to
# transitively compute the number of parents referred to by each parent.

my @parents = @_;
my %all_parents = map {$_ => 1} @parents;

my %parents_of = map {
  my $t = $_;
  my %attributes = parent_attributes($_);
  $t => [grep /^parent::/, keys %attributes]} @parents;

my %parent_count;
my $parent_count;
$parent_count = sub {
  my ($key) = @_;
  return $parent_count{$key} if exists $parent_count{$key};
  my $count = 0;
  $count += $parent_count->($_) + exists $data{$_} for @{$parents_of{$key}};
  $parent_count{$key} = $count};

my %inverses;
push @{$inverses{$parent_count->($_)} ||= []}, $_ for @parents;
grep exists $all_parents{$_}, map @{$inverses{$_}}, sort keys %inverses;
__
meta::internal_function('retrieve', <<'__');
my @results = map defined $data{$_} ? $data{$_} : retrieve_with_hooks($_), @_;
wantarray ? @results : $results[0];
__
meta::internal_function('retrieve_trimmed', <<'__');
return strip(retrieve($_[0])) if $transient{trim}{namespace($_[0])};
retrieve($_[0]);
__
meta::internal_function('retrieve_with_hooks', <<'__');
# Uses the hooks defined in $transient{retrievers}, and returns undef if none work.
my ($attribute) = @_;
my $result      = undef;

defined($result = &$_($attribute)) and return $result for map $transient{retrievers}{$_}, sort keys %{$transient{retrievers}};
return undef;
__
meta::internal_function('select_keys', <<'__');
my %options = @_;
grep attribute_is($_, %options), sort keys %data;
__
meta::internal_function('separate_options', <<'__');
# Things with one dash are short-form options, two dashes are long-form.
# Characters after short-form are combined; so -auv4 becomes -a -u -v -4.
# Also finds equivalences; so --foo=bar separates into $$options{'--foo'} eq 'bar'.
# Stops processing at the -- option, and removes it. Everything after that
# is considered to be an 'other' argument.

# The only form not supported by this function is the short-form with argument.
# To pass keyed arguments, you need to use long-form options.

my @parseable;
push @parseable, shift @_ until ! @_ or $_[0] eq '--';

my @singles = grep /^-[^-]/, @parseable;
my @longs   = grep /^--/,    @parseable;
my @others  = grep ! /^-/,   @parseable;

my @singles = map /-(.{2,})/ ? map("-$_", split(//, $1)) : $_, @singles;

my %options;
/^([^=]+)=(.*)$/ and $options{$1} = $2 for @longs;
++$options{$_} for grep ! /=/, @singles, @longs;

({%options}, grep length, @others, @_);
__
meta::internal_function('strip', 'wantarray ? map {s/^\\s*|\\s*$//sgo; $_} @_ : $_[0] =~ /^\\s*(.*?)\\s*$/so && $1;');
meta::internal_function('table_display', <<'__');
# Displays an array of arrays as a table; that is, with alignment. Arrays are
# expected to be in column-major order.

sub maximum_length_in {
  my $maximum = 0;
  length > $maximum and $maximum = length for @_;
  $maximum;
}

my @arrays    = @_;
my @lengths   = map maximum_length_in(@$_), @arrays;
my @row_major = map {my $i = $_; [map $$_[$i], @arrays]} 0 .. $#{$arrays[0]};
my $format    = join '  ', map "%-${_}s", @lengths;

join "\n", map strip(sprintf($format, @$_)), @row_major;
__
meta::internal_function('temporary_name', <<'__');
use File::Temp 'tempfile';
my (undef, $temporary_filename) = tempfile("$0." . 'X' x 4, OPEN => 0);
$temporary_filename;
__
meta::internal_function('translate_backtrace', <<'__');
my ($trace) = @_;
$trace =~ s/\(eval (\d+)\)/$locations{$1 - 1}/g;
$trace;
__
meta::internal_function('with_cwd', <<'__');
my ($dir, $f) = @_;
my $cwd = cwd();

my @result = eval {chdir $dir && &$f()};
chdir $cwd;
die $@ if $@;
wantarray ? @result : $result[0];
__
meta::internal_function('with_exported', <<'__');
# Like exported(), but removes the file after running some function.
# Usage is with_exported(@files, sub {...});
my $f      = pop @_;
my $name   = exported(@_);
my $result = eval {&$f($name)};
terminal::warning("$@ when running with_exported()") if $@;
unlink $name;
$result;
__
meta::internal_function('with_fork', <<'__');
my (@args) = @_;
my $f = pop @args;

return process->new($child_pid) if my $child_pid = fork;

# This is the child process. Disable saving to prevent contention, and then
# exit with the given status code.
*::save = sub {};
exit &$f(@args);
__
meta::library('process', <<'__');
package process;

sub new  {my ($class, $pid) = @_; bless \$pid, $class}
sub kill {my ($self, $signal) = @_; ::kill $signal // 'KILL', $$self; $self->wait()}
sub term {my ($self) = @_; $self->kill('TERM')}
sub int  {my ($self) = @_; $self->kill('INT')}
sub stop {my ($self) = @_; $self->kill('STOP')}
sub cont {my ($self) = @_; $self->kill('CONT')}

sub wait {my ($self) = @_; ::wait($$self)}
__
meta::library('shell', <<'__');
# Functions for shell parsing and execution.
package shell;
use Term::ReadLine;

sub tokenize {grep length, split /\s+|("[^"\\]*(?:\\.)?")/o, join ' ', @_};

sub parse {
  my ($fn, @args) = @_;
  s/^"(.*)"$/\1/o, s/\\\\"/"/go for @args;
  {function => $fn, args => [@args]}}

sub execute {
  my %command = %{$_[0]};
  die "undefined command: $command{function}" unless exists $externalized_functions{$command{function}};
  &{"::$command{function}"}(@{$command{args}})}

sub run {execute(parse(tokenize(@_)))}

sub prompt {
  my %options = @_;
  my $name    = $options{name} // ::name();

  my $indicators = join '', map &{"::$_"}(), ::select_keys('--namespace' => 'indicator');
  my $prefix     = $transient{repl_prefix} // '';

  "$prefix\033[1;32m$name\033[0;0m$indicators "}

sub repl {
  my %options = @_;

  my $term = new Term::ReadLine "$0 shell";
  $term->ornaments(0);
  my $attribs = $term->Attribs;
  $attribs->{completion_entry_function} = $attribs->{list_completion_function};

  my $autocomplete = $options{autocomplete} || sub {[sort(keys %data), grep !/-/, sort keys %externalized_functions]};
  my $prompt       = $options{prompt}       || \&prompt;
  my $parse        = $options{parse}        || sub {parse(tokenize(@_))};
  my $output       = $options{output}       || sub {print join("\n", @_), "\n"};
  my $command      = $options{command}      || sub {my ($command) = @_; ::around_hook('shell-command', $command, sub {&$output(::dangerous('', sub {execute($command)}))})};

  length $_ && &$command(&$parse($_)) while ($attribs->{completion_word} = &$autocomplete(), defined($_ = $term->readline(&$prompt())))}
__
meta::library('terminal', <<'__');
# Functions for nice-looking terminal output.
package terminal;

my $process = ::name();

sub message {print STDERR "[$_[0]] $_[1]\n"}
sub color {
  my ($name, $color) = @_;
  *{"terminal::$name"} = sub {chomp($_), print STDERR "\033[1;30m$process(\033[1;${color}m$name\033[1;30m)\033[0;0m $_\n" for map join('', $_), @_}}

my %preloaded = (info => 32, progress => 32, state => 34, debug => 34, warning => 33, error => 31);
color $_, $preloaded{$_} for keys %preloaded;
__
meta::message_color('cc', '36');
meta::message_color('state', 'purple');
meta::message_color('states', 'yellow');
meta::parent('object', <<'__');
bootstrap::html                         66b779578ac8b63db9b910931f5435f6
bootstrap::initialization               03d3fde57935dfda65c369bf02e750e9
bootstrap::perldoc                      b27489e0e570796019f591b08c98c43a
function::ad                            bcb317074915a656129f5355604bc152
function::alias                         719b3df46720217d69911974c6bdc50f
function::cat                           f684de6c8776617a437b76009114f52e
function::cc                            12ea9176e388400704d823433c209b7a
function::ccc                           d151a9793edd83f80fb880b7f0ab9b34
function::child                         e5acd8aeb16262c3f2a52f6f64344d30
function::clone                         e30a067adfa6fee67abe8d7afd8b1527
function::cp                            3fe69d1b58d90045ad520048977538c4
function::create                        3010d55f4dfa59a998742e07823ed54d
function::current-state                 6f03f86f1901e9ef07fdb5d4079a914c
function::cwd                           12833315b8bea35754ae9dabe45dfde8
function::disable                       53b449708cc2ffdefa352e53bb7d847d
function::edit                          20bb4117e5662906ad661a5f19e007d0
function::edit-self                     08e8695218a2d01fc608e3ad066ba15a
function::enable                        7de1cedc36841f5de8f9fdfbc3b65097
function::expanded-bootstrap            46d8e0b43646d3c32de0057077da607c
function::export                        2374cd1dbf7616cb38cafba4e171075d
function::extern                        1290a5223e2824763eecfb3a54961eff
function::grep                          55c3cea8ff4ec2403be2a9d948e59f14
function::hash                          6ee131d093e95b80039b4df9c7c84a02
function::hook                          675cdb98b5dd8567bdd5a02ead6184b5
function::hooks                         3d989899c616f7440429a2d9bf1cc44b
function::identity                      beb93f8ea57fcc8454661f9dd057645f
function::import                        114e09cf19f50ad92e268bb4227e145f
function::initial-state                 03d8ed608855a723124e79ca184d8e73
function::is                            e9103d343e6ef7142e3c537478158dc1
function::load-state                    970fba79b585e5638914a423bbeecf12
function::lock                          5d8db258704e6a8623fac796f62fac02
function::ls                            b2d40715eddbc2c0da299b54a0b53523
function::metadata-from                 b4f02937a7c80157e468bd9dbfcaf975
function::mv                            8b9d7817efbe38dff95aa99f3b51f32e
function::name                          955ba2d1fe1d67cd78651a4042283b00
function::parents                       3da9e63b5aae9e2f5dcc946a86d166aa
function::perl                          6d3994ec69c238535f4daed6658537fd
function::rd                            c41059d11d888922cfc5cbae92495632
function::reload                        1589f4cf8374e0011991cb8907afca3e
function::rm                            6f6fd7a6c25558eb469d78ea888f8551
function::rmparent                      e33a3a1e4f8f4156850d695fdfa7cf0d
function::save                          31f22a1bb7250567f236b6eab8e661b5
function::save-state                    fe99cbdb228608102ab6d55373146118
function::serialize                     133b52d4a95bee8ec397cffa25adfb30
function::serialize-single              0e1be51cdc0c8bcd94105a65c002e83f
function::sh                            b3bcea16a756d15b5de588a90198a0c2
function::shb                           9ee9d251ac3667f69e43d71d1073de01
function::shell                         e56eec74bb95a5d3cea974fd66acb433
function::size                          593810a7ce46e5a42584991b9c30d94c
function::snapshot                      56939a47f2758421669641e15ebd66eb
function::snapshot-if-necessary         68123e0e46509d9e56073683e1e023eb
function::state                         49b9310d43ef765345f080a23b929f15
function::touch                         3991b1b7c7187566f50e5e58ce01fa06
function::unlock                        b4aac02f7f3fb700acf4acfd9b180ceb
function::update                        f98ac65a795279cdbe67d6f3a5a05e42
function::update-from                   5d73d698fc55121c98bb6d7d3623ca53
function::usage                         5bdd370f5a56cfbf199e08d398091444
function::verify                        0c0cc1dfeab7d705919df122f7850a4f
indicator::cc                           3db7509c521ee6abfedd33d5f0148ed3
indicator::locked                       fc2b4f4ca0d6a334b9ac423d06c8f18c
indicator::path                         f7fc4b6dbc761995d991697a39e3e5ea
internal_function::around_hook          091ece60ac5ec692e49d95b447d070c1
internal_function::associate            0ac272611ee95f9cef89fc8676886abc
internal_function::attribute            dd6f010f9688977464783f60f5b6d3dd
internal_function::attribute_is         e93028037a8d673aa4a1abfe1b70cccb
internal_function::cache                eb9da45580a9ac0882baf98acd2ecd60
internal_function::chmod_self           2035e861eedab55ba0a9f6f5a068ca70
internal_function::dangerous            46c4baaa214ab3d05af43e28083d5141
internal_function::debug_trace          0faf9d9f4159d72dfe4481f6f3607ce1
internal_function::execute              560da5928d1d8858f3a64011ab3a8603
internal_function::exported             3ec48f01deefa840b52111f2e3f34749
internal_function::extension_for        9de8261d69cc93e9b92072b89c89befd
internal_function::fast_hash            ee5eba48f837fda0fe472645fdd8899a
internal_function::file::read           e647752332c8e05e81646a3ff98f9a8e
internal_function::file::write          0722e9f7e852269465e8e92d58ea8ffb
internal_function::fnv_hash             c36d56f1e13a60ae427afc43ba025afc
internal_function::hypothetically       417ae217d0caa9c09f470b7c27703788
internal_function::internal::main       c2410390ae10df76d89355c2a915aba5
internal_function::invoke_editor_on     5eb976796f0ec172d6ec036116a2f41e
internal_function::is_locked            da12ced6aa38295251f7e748ffd22925
internal_function::namespace            784d2e96003550681a4ae02b8d6d0a27
internal_function::parent_attributes    f6ccfaa982ab1a4d066043981aaca277
internal_function::parent_ordering      57b6da88f76b59f3fed9abfa61280e5e
internal_function::retrieve             8a34d1fe047fe1b40c3d2957c4a789eb
internal_function::retrieve_trimmed     ec9b2139757974d1e3149dd0f5acc393
internal_function::retrieve_with_hooks  0f1b0220ccd973d57a2e96ff00458cf2
internal_function::select_keys          a5e3532ec6d58151d0ee24416ea1e2b5
internal_function::separate_options     ae9043c4790e79013f1481b05f76d5df
internal_function::strip                7169402db5f2f19e6b2411c30f2006e1
internal_function::table_display        d575f4dc873b2e0be5bd7352047fd904
internal_function::temporary_name       6f548d101fc68356515ffd0fc9ae0c93
internal_function::translate_backtrace  d77a56d608473b3cd8a3c6cb84185e10
internal_function::with_cwd             d65eefc43140868a62d189f290da4b14
internal_function::with_exported        df345d5095d5ed13328ddd07ea922b36
internal_function::with_fork            d0963ac0472c5859c31e3177b37a90e8
library::process                        9cb64aa7459a61081116ffe86da21e44
library::shell                          6659bbab1051efd46b4a1a713edf6b28
library::terminal                       7e2d045782405934a9614fe04bcfe559
message_color::cc                       2218ef0f7425de5c717762ffb100eb43
message_color::state                    03621cd6ac0b1a40d703f41e26c5807f
message_color::states                   ac66eeeff487b5f43f88a78ea18b3d56
meta::configure                         69c2e727c124521d074fde21f8bbc4db
meta::externalize                       1a1f89e195408cd3911a898bf15b9f0b
meta::functor::editable                 48246c608f363de66511400e00b26164
meta::type::alias                       763587003448d1b7ddb2e287a52907d5
meta::type::bootstrap                   3baa75727784ea678d9dc1a6e1fb25f7
meta::type::cache                       2f093a1c4b0babc3a6678717f200d234
meta::type::data                        120e1649a468d3b3fd3fb783b4168499
meta::type::function                    a7eacad143e6353d4d3550d977330ffc
meta::type::hook                        49c580ff8ab284e2b7e288f350a50ad9
meta::type::inc                         d151f7a09366d906cf06de3dc109a2d2
meta::type::indicator                   ad120d47ee3650141c9c8da6c349ba8c
meta::type::internal_function           610adc3ec948ab7cc38662891a078d88
meta::type::library                     7a26afd979d35ceac7b775764f569780
meta::type::message_color               4a162012064f1dc472df1f9d8ff632f5
meta::type::meta                        c4a2b36b99de12d647828c12bdbea408
meta::type::parent                      28f7345e1438d6b8ef0e0dc7e6640910
meta::type::retriever                   a130f44d2fdac5cfc62baa07578c39ab
meta::type::state                       f4e27d3dc999ae7f7f530677c823554b
retriever::file                         3bbc9d8a887a536044bafff1d54def7e
retriever::global                       73c667c53b5f4422d215392129f3ed18
retriever::id                           4da6080168d32445150cc4200af7af6e
retriever::object                       d70d593ada2f108b2909a9fc24c4f63e
retriever::perl                         58a2d30d05c22bf6b4461d93ae46f361
__
meta::parent('vim-highlighters', <<'__');
function::vim                cf9e37026f6cd1499a6dd258fbbcd060
meta::type::vim_highlighter  38829105cbe400cb36d45357882c77fd
parent::object               20c70a494394d86d886f9f03e94e330b
__
meta::retriever('bin', <<'__');
# Compiles a binary text file.
my $name = $_[0];
return undef unless $name =~ s/^bin::/binary::/ && defined retrieve($name);
compile_binary($name);
__
meta::retriever('file', '-f $_[0] ? file::read($_[0]) : undef;');
meta::retriever('global', <<'__');
# Returns the global data stashed at the end of this perl object
$_[0] eq 'self' ? $global_data : undef;
__
meta::retriever('id', '$_[0] =~ /^id::/ ? substr($_[0], 4) : undef;');
meta::retriever('object', <<'__');
# Fetch a property from another Perl object. This uses the 'cat' function.
return undef unless $_[0] =~ /^object::(.*?)::(.*)$/ && -x $1 && qx|$1 is '$2'|;
join '', qx|$1 cat '$2'|;
__
meta::retriever('perl', <<'__');
# Lets you use the result of evaluating some Perl expression
return undef unless $_[0] =~ /^perl::(.*)$/;
eval $1;
__
meta::vim_highlighter('binary', <<'__');
" Language: Binary text
" Creator:  Spencer Tipping <spencer@spencertipping.com>
" License:  MIT source code license

syn case match

syn match bt_line_comment       /#.*/
syn match bt_binary_octet       /-[01]\{8\}/
syn match bt_octal_byte         /o[0-3][0-7]\{2\}/
syn match bt_hex_octet          /[0-9a-f]\{2\}/
syn match bt_repetition_prefix  -/\d\+/-
syn match bt_address            -@[0-9a-f]\+-
syn match bt_align              -@:[0-9a-f]\+-
syn match bt_place              -@![0-9a-f]\+-
syn match bt_debug              -@?\w\+-
syn match bt_ascii              -'\S\+-

syn match bt_label              /::\S\+/

syn region bt_expression        matchgroup=bt_expression_bracket start=/:\d*\[/ end=/]/ keepend
syn match  bt_label_definition  /::\S\+/      contained containedin=bt_expression
syn match  bt_label_ref         /:\S\+/       contained containedin=bt_expression
syn match  bt_here              /:</          contained containedin=bt_expression
syn match  bt_there             /:>/          contained containedin=bt_expression
syn match  bt_endian            /[BL][1-9]\?/ contained containedin=bt_expression
syn match  bt_perl_number       /0x[0-9a-f]\+\|0[0-7]\+\|\d\+/ contained containedin=bt_expression

hi link bt_line_comment      Comment
hi link bt_binary_octet      Keyword
hi link bt_octal_byte        Keyword
hi link bt_hex_octet         Type
hi link bt_repetition_prefix Preproc
hi link bt_address           Preproc
hi link bt_place             Identifier
hi link bt_align             Identifier
hi link bt_debug             Comment
hi link bt_ascii             String

hi link bt_label              Identifier
hi link bt_expression_bracket Special
hi link bt_label_ref          Identifier
hi link bt_label_definition   Identifier
hi link bt_here               Keyword
hi link bt_there              Keyword
hi link bt_endian             Special
hi link bt_perl_number        Number

__
internal::main();

__DATA__