in reply to Pure Perl tail call optimization
Hello,
In order to use goto to obtain true tail recursion, you need to use goto LABEL and not goto SUB because the later does just what the regular call does. Here is one way how you might do your factorial example:
printf "10 factorial is %d", scheme_procs('factorial', 1, 10); my $ls = mklist(1,5,5,7,3,6); # make a list print pair_str($ls) . "\n"; # print it my $max = scheme_procs('max', $ls); # get the max printf "Max is $max\n"; #pair_push($ls,$ls); # make a circular list!! # now do the bad thing, never terminate but monitor # memory usage #$max = scheme_procs('max', $ls); # get the max #printf "Max is $max\n"; ################################################### # call scheme_procs(proc name, args); ################################################### sub scheme_procs{ my $proc = shift; if($proc eq 'max'){ # go to the correct label goto SCM_MAX; } elsif($proc eq 'factorial'){ goto SCM_FACTORIAL; } else { die "no such proc: $proc"; } SCHEME_RP: # return the return values if(wantarray){ return(@_); } else { return $_[0]; } SCM_FACTORIAL: my ($total,$n) = @_; if($n == 0){ @_ = ($total); goto SCHEME_RP; # return } else { @_ = ($total*$n, $n - 1); goto SCM_FACTORIAL; # tail call } SCM_MAX: my $p = shift; print_resources(); if(null($p)){ die "Error"; } if(null(cdr($p))){ @_ = (car($p)); goto SCHEME_RP; # return } else { if(car($p) > (car(cdr($p)))){ @_ = (cons(car($p), cdr(cdr($p)))); goto SCM_MAX; # tail call } else { @_ = (cdr($p)); goto SCM_MAX; # tail call } } } # helper functions for our simplistic scheme subsystem sub cons{ my($a,$d) = @_; [$a,$d] } sub car{ shift->[0] } sub cdr{ shift->[1] } sub null{ not defined shift } sub set_cdr{ my ($ls, $v) = @_; $ls->[1] = $v } sub mklist{ return unless @_; return cons(shift, mklist(@_)); } sub pair_str{ my $p = shift; if(ref $p eq 'ARRAY'){ "(" . pair_str(car($p)) . " " . pair_str(cdr($p)) . ")"; } else { if(null($p)){ "()" } else { $p; } } } # this is a really bad resource monitor but works to monitor # memory growth to check for proper tail recursion sub print_resources{ my @lines = grep {$_ =~ /\s+(\d+)/ and $1 eq $$} `ps u`; print @lines; }
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Re: Pure Perl tail call optimization
by pdcawley (Hermit) on Apr 26, 2002 at 05:35 UTC | |
by TimToady (Parson) on Mar 05, 2004 at 20:02 UTC | |
by abstracts (Hermit) on Apr 26, 2002 at 06:18 UTC | |
by samtregar (Abbot) on Apr 26, 2002 at 08:37 UTC |
In Section
Meditations