On Wed, May 23, 2001 Andy Wardley wrote:
> On Wed, May 23, 2001 at 02:30:40PM +0800, Stas Bekman wrote:
> > depending on that feature. Not having this context makes all the functions
> > that use wantarray() half usable and unintuitive. Of course your patch
> > provides this feature, but are there any reasons for not having these in
> > core?
>
> None that I can think of.
>
> To do the job properly will require some hacking on the stash to either
> set flags to denote the context in which a variable should be evaluated,
> or provide different methods, get(...), get_list(...). It probably
> wouldn't be too hard to hack the parser grammar to accept an optional
> '@' as a prefix on a variable name and generate the appropriate Perl
> code to fetch the variable from the stash using the get_list() method,
> or by setting a LIST_CONTEXT flag, instead of the default scalar context
> method.
>
> But until then, I'm happy to apply this functionality to the core.
Here's a better set of features for the core. Attached is a new version
of Stash.pm (based on TT2.02) that:
- supports the special op "scalar" that forces scalar context on
function calls, eg:
cgi.param("foo").scalar
calls cgi.param("foo") in scalar context (unlike my wimpy
scalar op from last night). Array context is the default.
With non-function operands, scalar behaves like the perl
version (eg: no-op for scalar, size for arrays, etc).
- supports the special op "ref" that behaves like the perl ref.
If applied to a function the function is not called. Eg:
cgi.param("foo").ref
does *not* call cgi.param and evaluates to "CODE". Similarly,
HASH.ref, ARRAY.ref return what you expect.
- adds a new scalar and list op called "array" that is a no-op for
arrays and promotes scalars to one-element arrays.
- allows scalar ops to be applied to arrays and hashes in place,
eg: ARRAY.repeat(3) repeats each element in place.
- allows list ops to be applied to scalars by promoting the scalars
to one-element arrays (like an implicit "array"). So you can
do things like SCALAR.size, SCALAR.join and get a useful result.
This also means you can now use x.0 to safely get the first element
whether x is an array or scalar.
The new Stash.pm passes the TT2.02 test suite. But I haven't tested the
new features very much. One nagging implementation problem is that the
"scalar" and "ref" ops have higher precedence than user variable names.
[BTW, I noticed a minor bug with numerical dot operands in an lvalue.
Hashes will be created instead of arrays, eg:
x.y.0 = "abc";
x.y.1 = "def";
does this:
x.y = {"0" => "abc", "1" => "def"}
rather than the more natural:
x.y = ["abc", "def"];
This could be fixed, but I didn't get around to it, and you could argue
the default behavior is reasonable.]
Attached are the diffs for Stash.pm.
Craig
*** Stash.pm.orig Fri Apr 6 04:04:58 2001
--- Stash.pm Wed May 23 23:50:54 2001
***************
*** 52,57 ****
--- 52,58 ----
$SCALAR_OPS = {
'length' => sub { length $_[0] },
'defined' => sub { return 1 },
+ 'array' => sub { return [$_[0]] },
'repeat' => sub {
my ($str, $count) = @_;
$str = '' unless defined $str; $count ||= 1;
***************
*** 110,115 ****
--- 111,117 ----
'first' => sub { my $list = shift; $list->[0] },
'last' => sub { my $list = shift; $list->[$#$list] },
'reverse' => sub { my $list = shift; [ reverse @$list ] },
+ 'array' => sub { return $_[0] },
'join' => sub {
my ($list, $joint) = @_;
join(defined $joint ? $joint : ' ',
***************
*** 270,276 ****
# ($self) as the first implicit 'result'...
foreach (my $i = 0; $i <= $size; $i += 2) {
! $result = $self->_dotop($root, @$ident[$i, $i+1]);
last unless defined $result;
$root = $result;
}
--- 272,285 ----
# ($self) as the first implicit 'result'...
foreach (my $i = 0; $i <= $size; $i += 2) {
! if ( $i + 2 <= $size && ($ident->[$i+2] eq "scalar"
! || $ident->[$i+2] eq "ref") ) {
! $result = $self->_dotop($root, @$ident[$i, $i+1], 0,
! $ident->[$i+2]);
! $i += 2;
! } else {
! $result = $self->_dotop($root, @$ident[$i, $i+1]);
! }
last unless defined $result;
$root = $result;
}
***************
*** 400,406 ****
#========================================================================
#------------------------------------------------------------------------
! # _dotop($root, $item, \@args, $lvalue)
#
# This is the core 'dot' operation method which evaluates elements of
# variables against their root. All variables have an implicit root
--- 409,415 ----
#========================================================================
#------------------------------------------------------------------------
! # _dotop($root, $item, \@args, $lvalue, $nextItem)
#
# This is the core 'dot' operation method which evaluates elements of
# variables against their root. All variables have an implicit root
***************
*** 423,431 ****
#------------------------------------------------------------------------
sub _dotop {
! my ($self, $root, $item, $args, $lvalue) = @_;
my $rootref = ref $root;
! my ($value, @result);
$args ||= [ ];
$lvalue ||= 0;
--- 432,443 ----
#------------------------------------------------------------------------
sub _dotop {
! my ($self, $root, $item, $args, $lvalue, $nextItem) = @_;
my $rootref = ref $root;
! my ($value, @result, $ret, $retVal);
! $nextItem ||= "";
! my $scalarContext = 1 if ( $nextItem eq "scalar" );
! my $returnRef = 1 if ( $nextItem eq "ref" );
$args ||= [ ];
$lvalue ||= 0;
***************
*** 438,443 ****
--- 450,463 ----
return undef
unless defined($root) and defined($item) and $item !~ /^[\._]/;
+ if (ref(\$root) eq "SCALAR" && !$lvalue &&
+ (($value = $LIST_OPS->{ $item }) || $item =~ /^\d+$/) ) {
+ #
+ # Promote scalar to one element list, to be processed below.
+ #
+ $rootref = 'ARRAY';
+ $root = [$root];
+ }
if ($rootref eq __PACKAGE__ || $rootref eq 'HASH') {
# if $root is a regular HASH or a Template::Stash kinda HASH (the
***************
*** 447,455 ****
# pseudo-methods table, calling the code if found, or return undef.
if (defined($value = $root->{ $item })) {
! return $value unless ref $value eq 'CODE'; ## RETURN
! @result = &$value(@$args); ## @result
! }
elsif ($lvalue) {
# we create an intermediate hash if this is an lvalue
return $root->{ $item } = { }; ## RETURN
--- 467,476 ----
# pseudo-methods table, calling the code if found, or return undef.
if (defined($value = $root->{ $item })) {
! ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
! $scalarContext);
! return $retVal if ( $ret ); ## RETURN
! }
elsif ($lvalue) {
# we create an intermediate hash if this is an lvalue
return $root->{ $item } = { }; ## RETURN
***************
*** 457,462 ****
--- 478,491 ----
elsif ($value = $HASH_OPS->{ $item }) {
@result = &$value($root, @$args); ## @result
}
+ elsif ($value = $SCALAR_OPS->{ $item }) {
+ #
+ # Apply scalar ops to every hash element, in place.
+ #
+ foreach my $key ( keys %$root ) {
+ $root->{$key} = &$value($root->{$key}, @$args);
+ }
+ }
}
elsif ($rootref eq 'ARRAY') {
***************
*** 467,476 ****
if (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
@result = &$value($root, @$args); ## @result
}
elsif ($item =~ /^\d+$/) {
$value = $root->[$item];
! return $value unless ref $value eq 'CODE'; ## RETURN
! @result = &$value(@$args); ## @result
}
}
--- 496,514 ----
if (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
@result = &$value($root, @$args); ## @result
}
+ elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
+ #
+ # Apply scalar ops to every array element, in place.
+ #
+ for ( my $i = 0 ; $i < @$root ; $i++ ) {
+ $root->[$i] = &$value($root->[$i], @$args); ## @result
+ }
+ }
elsif ($item =~ /^\d+$/) {
$value = $root->[$item];
! ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
! $scalarContext);
! return $retVal if ( $ret ); ## RETURN
}
}
***************
*** 484,497 ****
# UNIVERSAL object base class) then we call the item as a method.
# If that fails then we try to fallback on HASH behaviour if
# possible.
! eval { @result = $root->$item(@$args); };
if ($@) {
# failed to call object method, so try some fallbacks
if (UNIVERSAL::isa($root, 'HASH')
! && defined($value = $root->{ $item })) {
! return $value unless ref $value eq 'CODE'; ## RETURN
! @result = &$value(@$args);
}
elsif (UNIVERSAL::isa($root, 'ARRAY')
&& ($value = $LIST_OPS->{ $item })) {
--- 522,540 ----
# UNIVERSAL object base class) then we call the item as a method.
# If that fails then we try to fallback on HASH behaviour if
# possible.
! return ref $root->can($item) if ( $returnRef ); ## RETURN
! eval {
! @result = $scalarContext ? scalar $root->$item(@$args)
! : $root->$item(@$args); ## @result
! };
if ($@) {
# failed to call object method, so try some fallbacks
if (UNIVERSAL::isa($root, 'HASH')
! && defined($value = $root->{ $item })) {
! ($ret, $retVal, @result) = _dotop_return($value, $args,
! $returnRef, $scalarContext);
! return $retVal if ( $ret ); ## RETURN
}
elsif (UNIVERSAL::isa($root, 'ARRAY')
&& ($value = $LIST_OPS->{ $item })) {
***************
*** 519,526 ****
# fold multiple return items into a list unless first item is undef
if (defined $result[0]) {
! return ## RETURN
! scalar @result > 1 ? [ @result ] : $result[0];
}
elsif (defined $result[1]) {
die $result[1]; ## DIE
--- 562,577 ----
# fold multiple return items into a list unless first item is undef
if (defined $result[0]) {
! return ref(@result > 1 ? [ @result ] : $result[0])
! if ( $returnRef ); ## RETURN
! if ( $scalarContext ) {
! return scalar @result if ( @result > 1 ); ## RETURN
! return scalar(@{$result[0]}) if ( ref $result[0] eq "ARRAY" );
! return scalar(%{$result[0]}) if ( ref $result[0] eq "HASH" );
! return $result[0]; ## RETURN
! } else {
! return @result > 1 ? [ @result ] : $result[0]; ## RETURN
! }
}
elsif (defined $result[1]) {
die $result[1]; ## DIE
***************
*** 530,535 ****
--- 581,610 ----
}
return undef;
+ }
+
+ #------------------------------------------------------------------------
+ # ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
+ # $scalarContext);
+ #
+ # Handle the various return processing for _dotop
+ #------------------------------------------------------------------------
+ sub _dotop_return
+ {
+ my($value, $args, $returnRef, $scalarContext) = @_;
+ my(@result);
+
+ return (1, ref $value) if ( $returnRef ); ## RETURN
+ if ( $scalarContext ) {
+ return (1, scalar(@$value)) if ref $value eq 'ARRAY'; ## RETURN
+ return (1, scalar(%$value)) if ref $value eq 'HASH'; ## RETURN
+ return (1, scalar($value)) unless ref $value eq 'CODE'; ## RETURN;
+ @result = scalar &$value(@$args) ## @result;
+ } else {
+ return (1, $value) unless ref $value eq 'CODE'; ## RETURN
+ @result = &$value(@$args); ## @result
+ }
+ return (0, undef, @result);
}
