Closures
From JmPm
Contents |
Closure And its Usage
my sub xx { my $n; $n = 5 }
- $n inaccessible from outside function
- here $n always disappears
- Or does it always ???
Anonymous Function
sub { … … … }
What is it good for ?
Closure - basic
Lets combine my + anonymous function
sub xx { my $n; return sub { $n++; } }
- $n not accessible outside xx
- $n does not disappear, since anonymous function needs it.
- For good explanation see M.J. Dominus Higher Order Perl pp. 71-79
Example - counter
sub create_cnt { my $start = 1; return sub { $start++; } }
Counter - use
$c1 = create_cnt(); #cnt1 $c2 = create_cnt(); #cnt2 $c1->(); $c1->(); $c1->(); $v1 = $c1->(); $c2->(); $v2 = $c2->(); print "v1 = $v1, v2 = $v2\n";
sub create_cnt { my $start = 1; return sub { $start++; } }
Counter – more interesting
$c1 = create_cnt(1, 1); $c2 = create_cnt(7, 3); $c1->(); $c1->(); $c1->(); $v1 = $c1->(); $c2->(); $c2->(); $v2 = $c2->(); print "v1 = $v1, v2 = $v2\n";
different start and delta
sub create_cnt { my ($start, $inc) = @_; my $current; return sub { $current = $current ? $current += $inc: $start; } }
Interval
sub time_int () { my $start = time(); return sub (){ my $current = time(); my $diff = $current - $start; $start = $current; return $diff; } }
Interval - use
my $t1 = time_int(); my $t2 = time_int(); for (1..4) { sleep(3); my $d1 = $t1->(); print "$d1\n"; } my $d2 = $t2->(); print "$d2\n";
sub time_int () { my $start = time(); return sub (){ my $current = time(); my $diff = $current - $start; $start = $current; return $diff; } }
Regexes - Task
• For ‘12345678’ • For any substring, e.g.34 • Print char before, then substring, then char after, e.g 1234 • Program to implement:
' ' 'Regexes – implementation 1' ' '
my @x = @ARGV; $str = '12345678'; foreach $cur (@x) { my ($res) = $str =~ /(.?$cur.?)/; print "cur = $cur, res = $res\n" }
Probem • Regex is compiled for each substring • We cannot anticipate all substrings • Closure to the rescue!
Regex with Closure
my @x = @ARGV; $str = '12345678'; foreach $cur (@x) { unless (defined $regex{$cur}) { $regex{$cur} = sdd_regex($cur); # key substr, val closure print "create for $cur\n"; } else { print "already exists for $cur\n"; } my $res = $regex{$cur}->(\$str); # use closure print "cur = $cur, res = $res\n"; }
sub sdd_regex () { my $s = shift; my $reg = qr/(.?$s.?)/; ## compile once for substr sub () { my $str = shift; #my ($r) = $$str =~ /(.?$s.?)/; my ($r) = $$str =~ /$reg/; return $r; } }