package Class::MethodMaker::array;
use strict;
use warnings;

use AutoLoader 5.57  qw( AUTOLOAD );
our @ISA = qw( AutoLoader );

use Carp qw( carp croak cluck );

use constant DEBUG => $ENV{_CMM_DEBUG} ? 1 : 0;

__END__

=head1 NAME

Class::Method::array - Create methods for handling an array value.

=head1 SYNOPSIS

  use Class::MethodMaker
    [ array => [qw/ x /] ];

  $instance->x;                # empty
  $instance->x(1, 1, 2, 3, 5, 8);
  $instance->x_count == 6;     # true
  $instance->x = (13, 21, 34);
  $instance->x_index(1) == 21; # true

=head1 DESCRIPTION

Creates methods to handle array values in an object.  For a component named
C<x>, by default creates methods C<x>, C<x_reset>, C<x_clear>, C<x_isset>,
C<x_count>, C<x_index>, C<x_push>, C<x_pop>, C<x_unshift>, C<x_shift>,
C<x_splice>.


Methods available are:

=head3 C<*>

I<Created by default.> This method returns the list of values stored in the
slot.  If any arguments are provided to this method, they B<replace> the
current list contents.  In an array context it returns the values as an array
and in a scalar context as a reference to an array.  Note that this reference
is no longer a direct reference to the storage, in contrast to
Class::MethodMaker v1.  This is to protect encapsulation.  See x_ref if you
need that functionality (and are prepared to take the associated risk.)  This
function no longer auto-expands arrayrefs input as arguments, since that makes
it awkward to set individual values to arrayrefs.  See x_setref for that
functionality.

If a default value is in force, then that value will be auto-vivified (and
therefore set) for each otherwise I<unset> (not I<not defined>) value up to
the array max (so new items will not be appended)


=head3 C<*_reset>

I<Created by default.> Called without an argument, this resets the component
as a whole; deleting any associated storage, and returning the component to
its default state.  Normally, this means that C<*_isset> will return false,
and C<*> will return undef.  If C<-default> is in effect, then the component
will be set to the default value, and C<*_isset> will return true.  If
C<-default_ctor> is in effect, then the default subr will be invoked, and its
return value used to set the value of the component, and C<*_isset> will
return true.

If called with arguments, these arguments are treated as indexes into the
component, and the individual elements thus referenced are reset (their
storage deleted, so that C<*_isset(n)> will return false for appropriate I<n>,
except where C<-default> or C<-default_ctor> are in force, as above).  As with
perl arrays, resetting the highest set value implicitly decreases the count
(but x_reset(n) never unsets the aggregate itself, even if all the elements
are not set).


=head3 C<*_clear>

  package MyClass;
  use Class::MethodMaker
    [ scalar => [{'*_clear' => '*_clear'}, 'a'],
      new    => new, ];

  package main;
  my $m = MyClass->new;
  $m->a(5);
  $a = $m->a;       # 5
  $x = $m->a_isset; # true
  $m->a_clear;
  $a = $m->a;       # *undef*
  $x = $m->a_isset; # true

I<Created on request>.  A shorthand for setting to undef.  Note that the
component will be set to undef, not reset, so C<*_isset> will return true.


=head3 C<*_isset>

I<Created by default.> Whether the component is currently set.  This is
different from being defined; initially, the component is not set (and if
read, will return undef); it can be set to undef (which is a set value, which
also returns undef).  Having been set, the only way to unset the component is
with <*_reset>.

If a default value is in effect, then <*_isset> will always return true.

C<*_isset()> tests the component as a whole.  C<*_isset(a)> tests the element
indexed by I<a>.  C<*_isset(a,b)> tests the elements indexed by I<a>, I<b>,
and returns the logical conjunction (I<and>) of the tests.


=head3 C<*_count>

I<Created by default.> Returns the number of elements in this component.  This
is not affected by presence (or lack) of a C<default> (or C<default_ctor>).
Returns C<undef> if whole component not set (as per C<*_isset>).


=head3 C<*_index>

I<Created by default.> Takes a list of indices, returns a list of the
corresponding values.

If a default (or a default ctor) is in force, then a lookup by
index will vivify & set to the default the respective elements (and
therefore the aggregate data-structure also, if it's not already).

Beware of a bug in perl 5.6.1 that will sometimes invent values in
previously unset slots of arrays that previously contained a value.
So, vivifying a value (e.g. by x_index(2)) where x_index(1) was
previously unset might cause x_index(1) to be set spuriously.  This
is fixed in 5.8.0.


=head3 C<*_push>

I<Created by default.> Push item(s) onto the end of the list.  No return
value.


=head3 C<*_pop>

I<Created by default.> Given a number, pops that many items off the end of the
list, and returns them (as a ref in scalar context, as a list in list
context).  Without an arg, always returns a single element.  Given a number,
returns them in array order (not in reverse order as multiple pops would).


=head3 C<*_unshift>

I<Created by default.> Push item(s) onto the start of the list.  No return
value.


=head3 C<*_shift>

I<Created by default.> Given a number, shifts that many items off the start of
the list, and returns them (as a ref in scalar context, as a list in list
context).  Without an arg, always returns a single element.  Given a number,
returns them in array order.


=head3 C<*_splice>

I<Created by default.> Arguments as for L<perldoc perlfunc splice|splice>.
Returns an arrayref in scalar context (even if a single item is spliced), and
a list in list context.


=head3 C<*_get>

I<Created on request>.  Retrieves the value of the component without setting
(ignores any arguments passed).


=head3 C<*_set>

  @n = $x->a; # (1,2,3)
  $x->a_set(1=>4,3=>7);
  @n = $x->a; # (1,4,3,7)

I<Created by default.> Takes a list, treated as pairs of index => value; each
given index is set to the corresponding value.  No return.

If two arguments are given, of which the first is an arrayref, then it is
treated as a list of indices of which the second argument (which must also be
an arrayref) are the corresponding values.  Thus the following two commands
are equivalent:

  $x->a_set(1=>4,3=>7);
  $x->a_set([1,3],[4,7]);

=cut


#------------------
# array 

sub arra0000 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat

sub arra0020 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex

sub arra0100 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex

sub arra0120 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default

sub arra0004 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default

sub arra0024 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default

sub arra0104 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default

sub arra0124 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class

sub arra0010 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class

sub arra0030 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class

sub arra0110 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class

sub arra0130 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class

sub arra0014 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class

sub arra0034 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class

sub arra0114 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class

sub arra0134 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static

sub arra0001 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static

sub arra0021 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static

sub arra0101 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static

sub arra0121 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static

sub arra0005 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static

sub arra0025 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - static

sub arra0105 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - static

sub arra0125 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static

sub arra0011 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static

sub arra0031 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static

sub arra0111 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static

sub arra0131 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static

sub arra0015 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static

sub arra0035 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class - static

sub arra0115 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class - static

sub arra0135 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor

sub arra0008 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor

sub arra0028 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default_ctor

sub arra0108 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default_ctor

sub arra0128 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor

sub arra0018 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor

sub arra0038 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - default_ctor

sub arra0118 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - default_ctor

sub arra0138 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor

sub arra0009 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor

sub arra0029 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static - default_ctor

sub arra0109 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static - default_ctor

sub arra0129 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor

sub arra0019 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor

sub arra0039 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static - default_ctor

sub arra0119 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static - default_ctor

sub arra0139 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array type

sub arra0002 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - type

sub arra0022 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - type

sub arra0006 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - type

sub arra0026 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - type

sub arra0012 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - type

sub arra0032 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - type

sub arra0016 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - type

sub arra0036 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - type

sub arra0003 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - type

sub arra0023 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static - type

sub arra0007 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static - type

sub arra0027 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - type

sub arra0013 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - type

sub arra0033 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static - type

sub arra0017 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static - type

sub arra0037 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor - type

sub arra000a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor - type

sub arra002a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor - type

sub arra001a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor - type

sub arra003a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor - type

sub arra000b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor - type

sub arra002b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor - type

sub arra001b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor - type

sub arra003b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array store_cb

sub arra0080 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - store_cb

sub arra00a0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - store_cb

sub arra0180 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - store_cb

sub arra01a0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - store_cb

sub arra0084 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - store_cb

sub arra00a4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - store_cb

sub arra0184 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - store_cb

sub arra01a4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - store_cb

sub arra0090 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - store_cb

sub arra00b0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - store_cb

sub arra0190 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - store_cb

sub arra01b0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - store_cb

sub arra0094 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - store_cb

sub arra00b4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class - store_cb

sub arra0194 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class - store_cb

sub arra01b4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - store_cb

sub arra0081 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - store_cb

sub arra00a1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static - store_cb

sub arra0181 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static - store_cb

sub arra01a1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static - store_cb

sub arra0085 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static - store_cb

sub arra00a5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - static - store_cb

sub arra0185 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - static - store_cb

sub arra01a5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - store_cb

sub arra0091 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - store_cb

sub arra00b1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static - store_cb

sub arra0191 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static - store_cb

sub arra01b1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static - store_cb

sub arra0095 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static - store_cb

sub arra00b5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class - static - store_cb

sub arra0195 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class - static - store_cb

sub arra01b5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor - store_cb

sub arra0088 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor - store_cb

sub arra00a8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default_ctor - store_cb

sub arra0188 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default_ctor - store_cb

sub arra01a8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor - store_cb

sub arra0098 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor - store_cb

sub arra00b8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - default_ctor - store_cb

sub arra0198 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - default_ctor - store_cb

sub arra01b8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor - store_cb

sub arra0089 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor - store_cb

sub arra00a9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static - default_ctor - store_cb

sub arra0189 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static - default_ctor - store_cb

sub arra01a9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor - store_cb

sub arra0099 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor - store_cb

sub arra00b9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static - default_ctor - store_cb

sub arra0199 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static - default_ctor - store_cb

sub arra01b9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array type - store_cb

sub arra0082 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - type - store_cb

sub arra00a2 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - type - store_cb

sub arra0086 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - type - store_cb

sub arra00a6 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - type - store_cb

sub arra0092 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - type - store_cb

sub arra00b2 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - type - store_cb

sub arra0096 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - type - store_cb

sub arra00b6 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - type - store_cb

sub arra0083 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - type - store_cb

sub arra00a3 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static - type - store_cb

sub arra0087 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static - type - store_cb

sub arra00a7 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - type - store_cb

sub arra0093 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - type - store_cb

sub arra00b3 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static - type - store_cb

sub arra0097 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static - type - store_cb

sub arra00b7 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor - type - store_cb

sub arra008a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor - type - store_cb

sub arra00aa {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor - type - store_cb

sub arra009a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor - type - store_cb

sub arra00ba {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor - type - store_cb

sub arra008b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor - type - store_cb

sub arra00ab {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor - type - store_cb

sub arra009b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor - type - store_cb

sub arra00bb {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array read_cb

sub arra0040 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - read_cb

sub arra0060 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - read_cb

sub arra0140 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - read_cb

sub arra0160 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - read_cb

sub arra0044 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - read_cb

sub arra0064 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - read_cb

sub arra0144 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - read_cb

sub arra0164 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - read_cb

sub arra0050 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - read_cb

sub arra0070 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - read_cb

sub arra0150 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - read_cb

sub arra0170 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - read_cb

sub arra0054 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - read_cb

sub arra0074 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class - read_cb

sub arra0154 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class - read_cb

sub arra0174 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - read_cb

sub arra0041 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - read_cb

sub arra0061 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static - read_cb

sub arra0141 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static - read_cb

sub arra0161 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static - read_cb

sub arra0045 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static - read_cb

sub arra0065 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - static - read_cb

sub arra0145 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - static - read_cb

sub arra0165 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - read_cb

sub arra0051 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - read_cb

sub arra0071 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static - read_cb

sub arra0151 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static - read_cb

sub arra0171 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static - read_cb

sub arra0055 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static - read_cb

sub arra0075 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class - static - read_cb

sub arra0155 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class - static - read_cb

sub arra0175 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor - read_cb

sub arra0048 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor - read_cb

sub arra0068 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default_ctor - read_cb

sub arra0148 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default_ctor - read_cb

sub arra0168 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor - read_cb

sub arra0058 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor - read_cb

sub arra0078 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - default_ctor - read_cb

sub arra0158 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - default_ctor - read_cb

sub arra0178 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor - read_cb

sub arra0049 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor - read_cb

sub arra0069 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static - default_ctor - read_cb

sub arra0149 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static - default_ctor - read_cb

sub arra0169 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor - read_cb

sub arra0059 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor - read_cb

sub arra0079 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static - default_ctor - read_cb

sub arra0159 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static - default_ctor - read_cb

sub arra0179 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array type - read_cb

sub arra0042 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - type - read_cb

sub arra0062 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - type - read_cb

sub arra0046 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - type - read_cb

sub arra0066 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - type - read_cb

sub arra0052 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - type - read_cb

sub arra0072 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - type - read_cb

sub arra0056 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - type - read_cb

sub arra0076 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - type - read_cb

sub arra0043 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - type - read_cb

sub arra0063 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static - type - read_cb

sub arra0047 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static - type - read_cb

sub arra0067 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - type - read_cb

sub arra0053 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - type - read_cb

sub arra0073 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static - type - read_cb

sub arra0057 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static - type - read_cb

sub arra0077 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor - type - read_cb

sub arra004a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor - type - read_cb

sub arra006a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor - type - read_cb

sub arra005a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor - type - read_cb

sub arra007a {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @x;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @x;
              } else {
                [@{$_[0]->{$name}} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor - type - read_cb

sub arra004b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor - type - read_cb

sub arra006b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor - type - read_cb

sub arra005b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor - type - read_cb

sub arra007b {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
  
              for (@x) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @x;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @x;
              } else {
                [@{$store[0]} = @x];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array store_cb - read_cb

sub arra00c0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - store_cb - read_cb

sub arra00e0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - store_cb - read_cb

sub arra01c0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - store_cb - read_cb

sub arra01e0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - store_cb - read_cb

sub arra00c4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - store_cb - read_cb

sub arra00e4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - store_cb - read_cb

sub arra01c4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - store_cb - read_cb

sub arra01e4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - store_cb - read_cb

sub arra00d0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - store_cb - read_cb

sub arra00f0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - store_cb - read_cb

sub arra01d0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - store_cb - read_cb

sub arra01f0 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - store_cb - read_cb

sub arra00d4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - store_cb - read_cb

sub arra00f4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class - store_cb - read_cb

sub arra01d4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class - store_cb - read_cb

sub arra01f4 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - store_cb - read_cb

sub arra00c1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - store_cb - read_cb

sub arra00e1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static - store_cb - read_cb

sub arra01c1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static - store_cb - read_cb

sub arra01e1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static - store_cb - read_cb

sub arra00c5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static - store_cb - read_cb

sub arra00e5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - static - store_cb - read_cb

sub arra01c5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - static - store_cb - read_cb

sub arra01e5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - store_cb - read_cb

sub arra00d1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - store_cb - read_cb

sub arra00f1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static - store_cb - read_cb

sub arra01d1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static - store_cb - read_cb

sub arra01f1 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static - store_cb - read_cb

sub arra00d5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static - store_cb - read_cb

sub arra00f5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default - tie_class - static - store_cb - read_cb

sub arra01d5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default - tie_class - static - store_cb - read_cb

sub arra01f5 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor - store_cb - read_cb

sub arra00c8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor - store_cb - read_cb

sub arra00e8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - default_ctor - store_cb - read_cb

sub arra01c8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - default_ctor - store_cb - read_cb

sub arra01e8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor - store_cb - read_cb

sub arra00d8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor - store_cb - read_cb

sub arra00f8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - default_ctor - store_cb - read_cb

sub arra01d8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - default_ctor - store_cb - read_cb

sub arra01f8 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor - store_cb - read_cb

sub arra00c9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor - store_cb - read_cb

sub arra00e9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - static - default_ctor - store_cb - read_cb

sub arra01c9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - static - default_ctor - store_cb - read_cb

sub arra01e9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor - store_cb - read_cb

sub arra00d9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor - store_cb - read_cb

sub arra00f9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array typex - tie_class - static - default_ctor - store_cb - read_cb

sub arra01d9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - typex - tie_class - static - default_ctor - store_cb - read_cb

sub arra01f9 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                    #   $_ += 0;
                    #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                    #                "  : should be '%s' (or subclass thereof)\n",
                    #                (defined($_)                                     ?
                    #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                    #                 '*undef*'
                    #                ), $typex))
                    #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
             #   $_ += 0;
             #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
             #                "  : should be '%s' (or subclass thereof)\n",
             #                (defined($_)                                     ?
             #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
             #                 '*undef*'
             #                ), $typex))
             #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array type - store_cb - read_cb

sub arra00c2 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - type - store_cb - read_cb

sub arra00e2 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - type - store_cb - read_cb

sub arra00c6 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - type - store_cb - read_cb

sub arra00e6 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - type - store_cb - read_cb

sub arra00d2 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - type - store_cb - read_cb

sub arra00f2 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - type - store_cb - read_cb

sub arra00d6 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - type - store_cb - read_cb

sub arra00f6 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - type - store_cb - read_cb

sub arra00c3 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - type - store_cb - read_cb

sub arra00e3 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - static - type - store_cb - read_cb

sub arra00c7 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - static - type - store_cb - read_cb

sub arra00e7 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - type - store_cb - read_cb

sub arra00d3 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - type - store_cb - read_cb

sub arra00f3 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default - tie_class - static - type - store_cb - read_cb

sub arra00d7 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default - tie_class - static - type - store_cb - read_cb

sub arra00f7 {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array default_ctor - type - store_cb - read_cb

sub arra00ca {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - default_ctor - type - store_cb - read_cb

sub arra00ea {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - default_ctor - type - store_cb - read_cb

sub arra00da {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - default_ctor - type - store_cb - read_cb

sub arra00fa {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
        my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $_[0]->{$name} ) {
                for (0..$#{$_[0]->{$name}}) {
                  tie @{$_[0]->{$name}}, $tie_class, @tie_args
                    unless exists ($_[0]->{$name}->[$_]);
                  if ( ! exists ($_[0]->{$name}->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$_[0]->{$name}}, $tie_class, @tie_args
                      unless exists $_[0]->{$name};
  
                    ($_[0]->{$name}->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $_[0]->{$name} ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$_[0]->{$name}};
                } else {
                  return [@{$_[0]->{$name}}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                @{$_[0]->{$name}} = @$v;
                return;
              } elsif ( $want ) {
                @{$_[0]->{$name}} = @$v;
              } else {
                [@{$_[0]->{$name}} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->[$_[1]]
             } else {
               return
                 for grep ! exists $_[0]->{$name}->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar @{$_[0]->{$name}};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->[$_]);
                 if ( ! exists ($_[0]->{$name}->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->[$_]) = $default
                 }
  
               }
               @{$_[0]->{$name}}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$_[0]->{$name}}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             push @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$_[0]->{$name}};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, -$_[1]] :
                              splice @{$_[0]->{$name}}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
             unshift @{$_[0]->{$name}}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$_[0]->{$name}};
             } else {
               splice @{$_[0]->{$name}}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$_[0]->{$name}}, 0, $_[1]] :
                              splice @{$_[0]->{$name}}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$_[0]->{$name}}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$_[0]->{$name}}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$_[0]->{$name}} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$_[0]->{$name}}, $tie_class, @tie_args
               unless exists $_[0]->{$name};
  
  
             splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$_[0]->{$name}}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array static - default_ctor - type - store_cb - read_cb

sub arra00cb {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - static - default_ctor - type - store_cb - read_cb

sub arra00eb {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array tie_class - static - default_ctor - type - store_cb - read_cb

sub arra00db {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
  
  
              @x = @_[1..$#_];
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
             return;
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------
# array v1_compat - tie_class - static - default_ctor - type - store_cb - read_cb

sub arra00fb {
  my $SENTINEL_CLEAR = \1;
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to array ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_reset *_index );
  
  return {
  
  
          '*'        =>
          sub : method {
      my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
  
            # We also deliberately avoid instantiating storage if not
            # necessary.
  
            if ( @_ == 1 ) {
  
              if ( exists $store[0] ) {
                for (0..$#{$store[0]}) {
                  tie @{$store[0]}, $tie_class, @tie_args
                    unless exists ($store[0]->[$_]);
                  if ( ! exists ($store[0]->[$_]) ) {
                    my $default = $dctor->($_[0]);
                    for ($default) {
                      croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                    "  : should be '%s' (or subclass thereof)\n",
                                    (defined($_)                                     ?
                                     (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                     '*undef*'
                                    ), $type))
                        unless ! defined $_ or UNIVERSAL::isa($_, $type);
                    }
                    tie @{$store[0]}, $tie_class, @tie_args
                      unless exists $store[0];
  
                    ($store[0]->[$_]) = $default
                  }
  ;
                }
              }
  
  
              if ( exists $store[0] ) {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return @{$store[0]};
                } else {
                  return [@{$store[0]}];
                }
              } else {
                if ( ! defined $want ) {
                  return;
                } elsif ( $want ) {
                  return ();
                } else {
                  return [];
                }
              }
            } else {
              {
                no warnings "numeric";
                $#_ = 0
                  if $#_ and defined $_[1] and $_[1] == $SENTINEL_CLEAR;
              }
  
              my @x;
  
              if ( $options->{tie_class} ) {
                @x = @_[1..$#_];
              } else {
                @x = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @_[1..$#_];
              }
  
  
  
  
              my $v = \@x;
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              for (@$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie @{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                @{$store[0]} = @$v;
                return;
              } elsif ( $want ) {
                @{$store[0]} = @$v;
              } else {
                [@{$store[0]} = @$v];
              }
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie @{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}[@_[1..$#_]];
            }
            return;
          },
  
  
  
          '*_clear'  =>
           sub : method {
             my $x = $names{'*'};
             $_[0]->$x($SENTINEL_CLEAR);
             return;
           },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->[$_[1]]
             } else {
               return
                 for grep ! exists $store[0]->[$_], @_[1..$#_];
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar @{$store[0]};
             } else {
  
               return 0;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie @{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->[$_]);
                 if ( ! exists ($store[0]->[$_]) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie @{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->[$_]) = $default
                 }
  
               }
               @{$store[0]}[@_[1..$#_]];
             }                     :
             sub : method {
               @{$store[0]}[@_[1..$#_]];
             }
           ),
  
  
           '*_push' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             push @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_pop' =>
           sub : method {
             if ( @_ == 1 ) {
               pop @{$store[0]};
             } else {
               return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, -$_[1]] :
                              splice @{$store[0]}, -$_[1] ;
             }
           },
  
  
           '*_unshift' =>
           sub : method {
             for (@_[1..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
             unshift @{$store[0]}, @_[1..$#_];
  
           },
  
  
           '*_shift' =>
           sub : method {
             if ( @_ == 1 ) {
               shift @{$store[0]};
             } else {
               splice @{$store[0]}, 0, $_[1], return
                 unless defined wantarray;
               ! wantarray ? [splice @{$store[0]}, 0, $_[1]] :
                              splice @{$store[0]}, 0, $_[1] ;
             }
           },
  
  
           '*_splice' =>
           sub : method {
             # Disturbing weirdness due to prototype of splice.
             #   splice @{$store[0]}, @_[1..$#_]
             # doesn't work because the prototype wants a scalar for
             # argument 2, so the @_[1..$#_] gets evaluated in a scalar
             # context, thus counts the elements of @_ (subtract 1).
             # Ripping of the head elements
             #   splice @{$store[0]}, $_[1], $_[2], @_[3..$#_]
             # almost works, but that the $_[2] if not present presents an
             # undef, which works as a zero, whereas
             #   splice @{$store[0]}, $_[1]
             # splices to the end of the array
  
             if ( @_ < 3 ) {
               if ( @_ < 2 ) {
                 $_[1] = 0;
               }
               $_[2] = @{$store[0]} - $_[1]
             }
             for (@_[3..$#_]) {
               croak(sprintf("Incorrect type for attribute $name: %s\n" .
                             "  : should be '%s' (or subclass thereof)\n",
                             (defined($_)                                     ?
                              (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                              '*undef*'
                             ), $type))
                 unless ! defined $_ or UNIVERSAL::isa($_, $type);
             }
             tie @{$store[0]}, $tie_class, @tie_args
               unless exists $store[0];
  
  
             splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_]), return
               unless defined wantarray;
             ! wantarray ? [splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])] :
                            splice(@{$store[0]}, $_[1], $_[2], @_[3..$#_])  ;
           },
  
  
           '!*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
  
           '*_set'   =>
           sub : method {
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}[@{$_[1]}] = @{$_[2]};
             } else {
               croak
                 sprintf("'%s' requires an even number of args (got %d)\n",
                         $names{'*_set'}, @_-1)
                 unless @_ % 2;
               for (@_[map $_*2,1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie @{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}[$_[$_*2-1]] = $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my @x;
                    my @y = $_[0]->$x();
                    @x = map +(defined $_ ? $_->$f(@_[1..$#_]) : undef), @y;
                    # We don't check for a undefined wantarray here, since
                    # calling this in a void context is a sufficiently
                    # nonsensical thing to do that checking for it is likely
                    # performance hit than the typical saving.
                    ! wantarray ? \@x : @x;
                  }
               } @forward),
         }, \%names;
}

#------------------------------------

1; # keep require happy