But local will work on elements of complex data structures. So you can declare a lexically scoped hash and then do things like local $foo{bar} = "baz";

sub lambda {
    my $f = $_[1];
    for my $x ( $_[0] ) {
        return sub {
            return localize( $x, $_[0], $f );
        }
    }
}
sub localize {
    my( $lexical, $val, $f )= @_;
    local( $_[0] )= $val;
    $f->();
}
[download]

(Updated order of arguments for no particularly good reason.)

Update: This, however, doesn't work (despite not generating an error). This is because (I believe) local localizes $_[0] by replacing the alias with a new SV that gets set to the new value. The prior value is restored by restoring the alias back into that spot in the array. Thus, the alias is never modified and thus the value of the lexical is never changed.

- tye        

Thanks, that's an extremely helpful response! I could probably twist my use cases (not the lambda example, perhaps, but some of the more dastardly ones) to have this approach work, too.

Is it possible to see the patch?

I'm sorry, but I'm on vacation and don't have time to search old mailing lists for the patch. Plus the code may have changed since the patch that I saw rejected several years ago.

A patch to make my do this has been turned down multiple times. It is technically easy to do, but Larry Wall's opinion is that it is too confusing.

Do I read this bit of Apocalypse 6 correctly to indicate that we need only wait until RSN to be able to ‘localise’ whatever we please?

Update: The following would also do if you could localise through a reference:

sub lambda {
    my $f = $_[1];
    my $xr = \$_[0];
    return sub {
        local $$xr = $_[0];
        return $f->();
    }
}
[download]

So how about emulating local using alias:

use Data::Alias       qw( alias );
use Object::Destroyer qw( );

sub lambda {
    my $f = $_[1];
    my $xr = \$_[0];
    return sub {
        alias my $temp = $$xr;
        alias $$xr = $_[0];
        my $sentry = Object::Destroyer->new(
            sub { alias $$xr = $temp; }
        );
        return $f->();
    }
}
[download]

This should work whether $x is a lexical or a package variable. This should work whether $x is tied or not. In fact, it works better than local with tied variables and creates an alias unlike local.

Untested.

Tested the parent: Doesn't work. (Specifically, my $xr = \$x; alias $$xr = $_[0]; isn't equivalent to alias $x = $_[0]; as I had hoped.) The best I can get using an arbitrary variable is:

package Lambda;

use strict;
use warnings;

use Exporter qw( import );

our @EXPORT = qw( lambda );

sub _on_destroy(&@) {
    return bless([@_], 'Lambda::OnDestroy');
}

sub Lambda::OnDestroy::DESTROY {
    my ($self) = @_;
    my ($cb, @args) = @$self;
    $cb->(@args) if $cb;
}

sub lambda {
    my $xr = \$_[0];
    my $f  =  $_[1];
    return sub {
        my $temp = $$xr;
        $$xr = $_[0];
        my $sentry = _on_destroy { $$xr = $temp; };
        return $f->();
    }
}

1;
[download]

use strict;
use warnings;

use Test::More tests => 10;

BEGIN { use_ok('Lambda') }

{
   my $x;
   my $f = lambda($x => sub { $x });
   is($f->('lex'), 'lex', 'lex1');
   is($f->('LEX'), 'LEX', 'lex2');
   is($x, undef, 'lex restore');
}

{
   local our $x;
   my $f = lambda($x => sub { $x });
   is($f->('pkg'), 'pkg', 'pkg1');
   is($f->('PKG'), 'PKG', 'pkg2');
   is($x, undef, 'pkg restore');
}

{
    my $f = do {
        my $x;
        lambda($x => sub { $x })
    };

    is($f->('out of scope'), 'out of scope', 'out of scope');
}

{
   my $y = 'test';
   my $x;
   lambda($x => sub { $x = uc($x) })->($y);
   is($y, 'TEST', 'alias');
}

{
    package Unfetchable;
    use Tie::Scalar qw( );
    our @ISA = 'Tie::StdScalar';
    sub FETCH { }
}

{
   tie my $x, 'Unfetchable';
   my $f = lambda($x => sub { $x });
   is($f->('test'), 'test', 'tied');
}
[download]

1..10
ok 1 - use Lambda;
ok 2 - lex1
ok 3 - lex2
ok 4 - lex restore
ok 5 - pkg1
ok 6 - pkg2
ok 7 - pkg restore
ok 8 - out of scope
not ok 9 - alias
#   Failed test 'alias'
#   at a.pl line 37.
#          got: 'test'
#     expected: 'TEST'
not ok 10 - tied
#   Failed test 'tied'
#   at a.pl line 50.
#          got: undef
#     expected: 'test'
# Looks like you failed 2 tests of 10.
[download]

Now, if you were ok with using $_ instead of using an arbitrary variable ($x), that's another story.

package Lambda;

use strict;
use warnings;

use Exporter qw( import );

our @EXPORT = qw( lambda );

sub lambda(&) {
    my ($f) = @_;
    return sub {
        return $f->() for $_[0];
    }
}

1;
[download]

use strict;
use warnings;

use Test::More tests => 6;

BEGIN { use_ok('Lambda') }

{
   local $_;
   my $f = lambda { $_ };
   is($f->('test'), 'test', 'test1');
   is($f->('TEST'), 'TEST', 'test2');
   is($_, undef, 'restore');
}

{
   my $y = 'test';
   ( lambda { $_ = uc($_) } )->($y);
   is($y, 'TEST', 'alias');
}

{
    package Unfetchable;
    use Tie::Scalar qw( );
    our @ISA = 'Tie::StdScalar';
    sub FETCH { }
}

{
   local $_;
   tie $_, 'Unfetchable';
   my $f = lambda { $_ };
   is($f->('test'), 'test', 'tied');
}
[download]

1..6
ok 1 - use Lambda;
ok 2 - test1
ok 3 - test2
ok 4 - restore
ok 5 - alias
ok 6 - tied
[download]

use strict;
use warnings;

package MyLocal;
use PadWalker qw(peek_my);

my %old_value;

sub new {
    my $self = shift;
    my %arg  = @_;

    my $h = peek_my($arg{level});
    $arg{h} = $h;
    bless \%arg;
}

sub set {
    my ($self, $variable , $value) = @_;

    if(! exists $old_value{$variable}) {
        $old_value{$variable} = ${ $self->{h}{$variable} };
    }
    ${ $self->{h}{$variable} } = $value;
}

DESTROY {
    my $self = shift;

    foreach my $var (keys %old_value) {
        ${ $self->{h}{$var} } = delete $old_value{$var};
    }
}

package main;

my $x = 1;
my $f = sub { $x };

{
    my $loc = MyLocal->new(level => 1);
    $loc->set('$x' => 2);
    print $f->(), "\n"; # => 2
}
print $f->(), "\n"; # => 1
[download]

Here is a working example that eschews all external dependencies and just "works", but requiring a less concise invocation:

#!/usr/bin/perl -w
use strict;

my $x = 1;
my $f = sub { $x };
{
    my $scope= tempSet( \$x, 2 );
    print $f->(), "\n"; # => 2
}
print $f->(), "\n"; # => 1

sub TempSet::DESTROY { shift(@_)->() }
sub tempSet {
    my( $sv, $new )= @_;
    my $prior= $$sv;
    my $restore= bless
        sub { $$sv= $prior },
        'TempSet';
    $$sv= $new;
    return $restore;
}
[download]

Unfortunately, this still (if I may use loose language) copies rather than aliasing, hence runs into trouble if $x is a tied variable (probably among other circumstances).

Given

sub Tie::TIESCALAR { return bless \$_[1] => $class }
sub Tie::FETCH { return ${$_[0]} }
sub Tie::STORE { $_[0] = "I'm not tied any more" }
[download]

if I replace my $x = 1 by tie my $x, 'Tie', 1, then the given code blows up upon leaving the inner scope.

UPDATE: Oops, $class should be $_[0].

Yes, providing quite broken 'tie' implementations can make any code blow up. q-:

Fixing your code so that it works and also demonstrates that things don't stop being tied shows that my code works fine with such things:

#!/usr/bin/perl -w
use strict;

# my $x = 1;
tie my $x, 'Tie', 1;
my $f = sub { $x };
print $f->(), "\n"; # => 1
{
    my $scope= tempSet( \$x, 2 );
    print $f->(), "\n"; # => 2
}
print $f->(), "\n"; # => 1

sub TempSet::DESTROY { shift(@_)->() }
sub tempSet {
    my( $sv, $new )= @_;
    my $prior= $$sv;
    my $restore= bless
        sub { $$sv= $prior },
        'TempSet';
    $$sv= $new;
    return $restore;
}

sub Tie::TIESCALAR { return bless \$_[1] => $_[0] }
sub Tie::FETCH { return "${$_[0]} is still tied at line " . (caller())
+[2] }
sub Tie::STORE { ( ${$_[0]} = $_[1] ) =~ s/ is still tied at line \d+$
+// }
[download]

which produces

1 is still tied at line 7
2 is still tied at line 10
1 is still tied at line 12
[download]

(Updated code to make tied-ness more apparent.)

(Yes, in constrast, local is implemented in a way that it temporarily hides the tied nature of the localized scalar.)

- tye        

And here's the syntactic sugar to make the invocation concise:

#!perl
use strict;
use warnings;

my $x = 1;
sub lambda
{
    my $fn = pop;
    my @argrefs = \(@_);
    sub {
      my @scopes= map { tempSet( $argrefs[$_], $_[$_] ) } 0..$#_;
      &$fn;
    }
}

my $y = 'Yval';
my $closure = lambda $x, $y => sub { "$x and $y" };

print $closure->($_, rand(3)), "(X=$x, Y=$y)\n" for (qw(a bitty china 
+doll));

print "$x and $y\n"; # => 1

sub TempSet::DESTROY { shift(@_)->() }
sub tempSet {
    my( $sv, $new )= @_;
    my $prior= $$sv;
    my $restore= bless
        sub { $$sv= $prior },
        'TempSet';
    $$sv= $new;
    return $restore;
}
[download]

---

Caution: Contents may have been coded under pressure.

Update: It has been pointed out to me that this post can be read as having hostile intent towards JadeNB. No such intent exists!

If there is an latent hostility underlying this post, it is directed at CS programs that concentrate on teaching gradtuate CS-only problems, instead of either real-world problems, or backing up their CS problem explorations with practical implementaions and examples of real-world use. Hence no one want to employ new grads until they've had 2 to 3 years writing "real" code.

But that does in no way preclude individuals from exploring whatever takes their fancy. I spend much of my time exporing ultimately useless tangents.

If there is any intended implied critisism of JadeNB, it is that he did not (has not) make clear what his actual goal in a maner that could be verified. Hence may of the solutions offered garnered repsponses like: "but that uses copies rather than aliases"; without providing any explanation or reason why aliases would be preferable for his (unstated) final objective. But I see others have voiced that critisism rather more bluntly.

I have a number of dastardly intentions, but perhaps the simplest is that I'd like to be able to write

sub lambda {
    my $f = $_[1];
    for my $x ( $_[0] ) {
        return sub {
            local $x = $_[0];
            return $f->();
        }
    }
}
[download]

Reading between the lines of your post (with its myriad updates), and your responses to peoples suggestions; it seems likely that what you are trying to achieve--without having stated it is your objective--is a Perlish Y Combinator?

If so, let me tell you it's already been done, and it looks like this:

sub Y {
    my ( $curried_rec ) = @_;
    sub {
        my ( $f1 ) = @_;
        $curried_rec->( sub { $f1->( $f1 )->( @_ ) } )
    }->( sub {
        my ( $f2 ) = @_;
        $curried_rec->( sub { $f2->( $f2 )->( @_ ) } )
    } )
}
[download]

Which is apprently very cool in CS circles because it allows you to do stuff like this:

print Y( sub {
    my ( $rec ) = @_;
    sub {
        my ( $n ) = @_;
        $n < 2 ? 1 : $n * $rec->( $n - 1 );
    }
} )->( 10 );;

3628800
[download]

Though quite why that is so cool--beyond being unintuative enough that CS students are unlikely to be able to work it out for themselves; and even once the Masterful lecturer has written it up on the board (copied rote from his notes), and "explained" it, it remains opaque enough to leave the student thinking the lecturer must be very clever--is beyond my reasoning.

NOTE: The above implementation is by the much missed Aristotle; and you can find his explaination of its derivation here.

Maybe something like this?

our $x = 1;
my $f = sub { $x };
{
    local $x;
    $x = 2;
    print $f->(), "\n";
}
print $f->(), "\n";
[download]

It doesn't give you a way to make my-declared variables local, though.

(I thought I posted this already, but it doesn't seem to have appeared. Let's see if I get two dups in a single thread!)

Thanks for the suggestion, but, unfortunately, it's only the bit in the inner scope that I control—given an existing coderef $f that closes over an existing lexical $x, I want to write some code that changes $x, but only temporarily, in such a way that $f ‘sees’ the change.

Of course, if you use XS, or Devel::Declare, anything is possible, but there's no pure Perl solution.

I'm a little confused by the response. It's not the dynamic-scoping-like behaviour that's the problem—

my $x = 1;
my $f = sub { $x };
{
    $x = 2;
    print $f->(), "\n"; # => 2
}
[download]

works as desired. (I'm sure that “dynamic scoping” isn't the right term for that, but I didn't know a better.) The real difficulty (for me, anyway) is making a change in an inner scope to a lexical variable in an outer scope in such a way that the change will ‘revert’ outside that scope.

It's not the dynamic-scoping-like behaviour that's the problem

Yes, it is:

The real difficulty (for me, anyway) is making a change in an inner scope to a lexical variable in an outer scope in such a way that the change will ‘revert’ outside that scope.

That's the dynamic scoping you're after.

Make $x a package variable, use local, and it will work the way you want. I don't see the point of making $x a lexical if you don't want lexical behaviour.

$ perl -wMstrict -e 'my $e = 77; warn $e; { my $e = 22; warn $e }; warn $e' gives, when run, :

77 at -e line 1.
22 at -e line 1.
77 at -e line 1.
[download]

Update:

Corrected error - original code would never produce stated results coz of missing intialization.

The problem is that the inner my $e is a completely different variable to the outer one, so that functions closing over the outer one don't ‘see’ it. To illustrate:

perl -wMstrict -e 'my $e = 77; my $f = sub { warn $e }; $f->(); { my $
+e = 22; $f->() } $f->();'
[download]

gives

77 at -e line 1
77 at -e line 1
77 at -e line 1
[download]

So in analogy to ruby

 lamb  = lambda  { |x, y, z| z = x + y}

you want to write

 $lamb = lambda ($x,$y,$z) => { $z = $x + $y }

such that  $lamb->(1,2,$a) sets $a to 3 ???

Yes, exactly, although I'd also like

$lamb = lambda ( $x, $y ) => sub { $x + $y }
[download]

to be such that $lamb->(1, 2) returns 3.

I think the most productive approach would be to post test code, assuring your intentions are understood, such that other stop posting speculative code...

Anyway I doubt that your desired "my_local" (or better named "lex-local") is what you need, since $x,$y,$z will always also belong to the outer scope, making ugly side-effects probable!

{ #outer scope
  $lamb = lambda ( $x, $y, $z ) => sub { $x + $y }
}
[download]

the following is simple and very close but lacks the same aliasing like $_[0] does.

  $lamb = sub { my ($x,$y,$z) = @_; $x + $y }

so using Data::Alias or Lexical::Alias might be what you need to install for lexicals. If you don't wanna install XS-Moduls try working with lex-refs

  DB<20> $lamb=sub { my($x,$y)=\(@_); $$x += $$y } 
  
  DB<21> $a=10; $lamb->($a,5); print $a
15
[download]

NOTE: Aliasing can always be achieved with * and pack-vars.

Cheers Rolf

So what you really want are anon subs with named arguments. Have you looked at

• signatures
• Sub::Signatures
• Method::Signatures
• Perl6::Subs
• Perl6::Parameters

use signatures;
my $lamb = sub ($x, $y) { $x + $y };
print( $lamb->(3,4), "\n" );  # 7
[download]

Unfortunately, the following doesn't work

use signatures;
my $lamb = sub ($x) { $x = 4 };
my $y = 3;
$lamb->($y);
print("$y\n");  # 3  XXX want 4
[download]

I also tried Sub::Signatures and Perl6::Subs. Both accept anonymous subs with named parameters. Neither pass the alias test.

Maybe one of them can be fixed. Maybe it works with one of the other modules.

Update: To spend the least amount of effort, your best bet is to fork signatures. It hooks itself into the parser to change

sub (...) { ... }
[download]

into

sub { my (...) = @_; ... }
[download]

By changing what gets injected (my (...) = @_;) to something like the following, you can achieve aliasing (which also fixes tied vars):

Lexical::Alias::alias(my $x, $_[0]);
Lexical::Alias::alias(my $y, $_[1]);
Lexical::Alias::alias(my $z, $_[2]);
[download]

It might be best to use copying semantics by default, while adding a mechanism to specify aliasing ("is rw"?). That would allow you to extend signatures instead of replacing it.

sub lambda {$_[1]}

our $x = 2;
my $f = lambda $x => sub {$x ** 2};
say $f->();
{
    local $x = 3;
    say $f->();
}
say $f->();
__END__
4
9
4
[download]

Of course, in Perl, one doesn't really need "lambda". Hence a lambda which just returns the sub.

Yes, I agree, if one is willing to set the variables ‘outside’—but I'd like to set them on the function call, so that I can write

my $f = lambda $x => sub { $x**2 };
say $f->(2); # => 4
say $f->(3); # => 9
[download]

(without affecting the value of $x). Of course you're right that Perl doesn't need lambda, in the sense that the imaginary code above functions exactly the same as the real code

my $f = sub { $_[0]**2 };
say $f->(2); # => 4
say $f->(3); # => 9
[download]

I just wanted to see if it could be done. (I have other examples that aren't just syntactic sugar, but the margin is too small to contain them they're not pretty.)

Seems you just want a complicated way of not writing $_[0] in the sub. That can be done of course. But why would you? And what has this to do with localizing a lexical, which you were asking about in your earlier posts? If you're passing in the parameter to the sub, there's no need to localize anything, is there?

my $f = sub {my $x = shift; sub {$x ** 2}->()};
say $f->(2);  # => 4
say $f->(3);  # => 9
[download]

#!perl
use strict;
use warnings;

sub lambda {
  my $varname = shift;
  my $fn_body = shift;
  my $estring= "sub { my \$$varname = shift; $fn_body }";
  print "Evaling $estring\n";
  eval $estring;
}

my $x = 3;
my $closure = lambda 'x' => q { $x**2 };
for (1..4) {
  print $closure->($_), "\n";
}
print "And my X is $x\n";
[download]

--- original below ---

#!perl
use strict;
use warnings;

sub lambda {
  my $varname = shift;
  my $fn = shift;
  my $pkg = do { no strict 'refs'; * {caller().'::'} };
  sub {
    local ${$pkg}{$varname} = \shift;
    $fn->()
  }
}

package a::b::c;

our $x;
my $closure = main::lambda 'x' => sub { $x**2 };
for (1..4) {
  print $closure->($_), "\n";
}
[download]

like all other "localizing" approaches the user is forced to do either my $x or our $x in the scope surrounding the lamda to use your solutions under use strict!

Cheers Rolf

Well, you could declare $x within the call to lambda, instead of surrounding it:

#!perl
use strict;
use warnings;

sub lambda {
  my $fn = pop;
  my @foo = @_; # foo references $x, etc.
  sub {
    # Put values into referenced params
    ${$foo[$_]} = $_[$_] for 0..$#_;
    &$fn;
  }
}

my $x = 3;

my $closure = lambda do {
  my ($x, $y);
  \($x, $y) => sub { print "Got $x and $y\n" }
} ;

$closure->($_, $_+1) for (1..4);

print "And my X is $x\n";
[download]

Though I suspect that's a distinction that won't be seen as advantageous. It's just as easy to write

my $closure = sub {
  my ($x, $y) = @_;
  print "Got $x and $y\n";
};
[download]

which is the Perlish way to do what the OP wants to do.

---

Caution: Contents may have been coded under pressure.

$lamb=sub { my($x,$y)=\(@_); $$x += $$y }

You just have to restrict referencing to arguments which are read/write and copying to read-only args.

Such that $$x signals clearly "x is an alias" and $y "y is only a copy".

 $lamb=sub { my $x= \shift; my ($y)=@_; $$x += $y }

Your code becomes much clearer and unintended changes to the original of $y are impossible, avoiding ugly and very hard to track bugs!!!

Unfortunately its not possible to write this as dense (but more error-redundant) than in ruby...

 
$lamb=sub { my ($$x,$y)=@_; $$x += $y } 
#  Can't declare scalar dereference in "my"
[download]

But maybe I'm missing another "way to do it"? ( would be please to know 8)

UPDATE: Of course you can use arraslices

 $a=sub { my($x,$y)=(\(@_[0]),@_[1]); $$x +=$y }

or

 $a=sub { my($x,$y)=(\($_[0]),$_[1]); $$x +=$y }

link to footnotes within my own comment, so I'll just leave others to navigate manually.

sure you can define anchor-names with a-tags and link to them with href to #name. E.g these KISSes are interlinked. Just look in the HTML-Source...

But I doubt footnotes may help clarify your update-inferno... ;-)

What I'm looking for is something that doesn't do any copying, but, rather, literally sets aside the variable and then restores it later.

Why did you post this as an update instead of replying to my node? I would have told you earlier that my solution does no copying. Please have a second look. If you still don't understand, let me know where you think copying is occuring.

Why did you post this as an update instead of replying to my node? I would have told you earlier that my solution does no copying.

Right on both counts, of course! I'm very sorry for not replying to your node; I was overwhelmed by the number of replies and the subtleties that came up as I tried to test them against my (un- and under-stated) expectations, and so went the lazy way of just updating the main post rather than replying to everyone individually.

It was this line:

alias my $temp = $$xr;

skimmed quickly, that made me think that there was copying, because I'm not familiar with the semantics of Data::Alias; I'm sorry for misunderstanding, and I will update my update accordingly.