Closures
From JmPm
Contents |
Closure And its Usage
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" }
Problem:
- 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; } }