# perl
$x = 1;
@a = (2,3,5,7);
($car,@cdr) = @a;

print $car, "\n";
print join(" ",@cdr), "\n";
print $cdr[1], "\n";
print $#cdr, "\n";
foreach (@cdr) { print $_, "\n" }
# _ is "it"  whatever is the most relevant thing at the moment.

sub f   # @_  is a list of parameters
{
    my @b = @_;  #// now call by value
    my $tmp = $_[0];   # my declares variable - similar to let in scheme
    $_[0] = $_[1];
    $_[1] = $tmp;
}

sub println { print @_; print "\n"; }

$y = 2;
print $x, " ", $y , "\n";
f($x,$y);
print $x, " ", $y , "\n";

# pointers
$px = \$x;  # int *p = &x;        pointer itself is a scalar
println $px;
$$px = 4;   # *px = 4;
println $$px;
$pl = \@cdr;
println $$pl[2];
println $pl->[1];   #$ -> derefs  in C++ n->f()  is (*n).f()

local $gcd; # need to declare first if recursive
$gcd = sub {
    my ($a,$b) = ($_[0],$_[1]);
    if ($a==0) {$b} else {$gcd->($b%$a,$a)}
};
println $gcd->(12,8);

$fact = sub
{   my $n = $_[0];
    my $ax = 1;
    while ($n>1) {$ax =$ax*$n--}
    $ax;
};

# closures
sub makeaccum
{
    my $y = $_[0];
    sub
    { $y += $_[0]; $y}
}
my $a1 = makeaccum(0);
my $a2 = makeaccum(0);
println $a1->(2);
println $a1->(2);
println $a1->(2);
println $a2->(2);


my $a = 1;
local $b = 10;

sub g { $a + $b }

{ 
    my $a = 2;      # statically scoped.
    local $b = 20;  # dynamically scoped
    println g();
}


# simulated dynamic scope
{
    my $a0 = $a;
    $a = 2;
    println g();
    $a = $a0;	
}

# Why use static scoping normally?  It's possible to answer this question
# in many ways.  The easiest way is that I want to know that my "local" 
# variable $a0 won't interfere with some function in some unexpected way.
# To be absolutely sure I would have to look at the source code of all
# functions as well as the code for all functions called by these functions...
# That's hardly the behavior I want out of "local" variables.


#######  When is dynamic scoping useful?
#1. temporarily replace the value of a global - stdout is already global.

#2. (subversive!) inject new behaviors into existing functions.
#  like WHEN I WANT TO INTERFERE WITH OTHER PEOPLE'S CODE. But that
#  could be for a legitimate purpose: I want to give them ADVICE:

### temporarily inject tracing behavior into some functions
$advice_tracecall = sub  # takes ($function,$args) as parameter
{
    my ($f,@params) = @_;  # f is itself a function, the "target" program

    my $basegcd = $gcd;
    my $callcount = 0;
    local $gcd = sub
    {   $callcount++;
	if ($callcount==1)  # don't trace recursive calls
	  { println("gcd being called on ", join(",",@_)); }
	$basegcd->(@_);
    };
    my $basefact = $fact;
    local $fact = sub
    {
	println("fact being called on ", join(",",@_));
	$basefact->(@_);
	
    };

    $f->(@params);  # run target program under advice
    # cross-cutting advice
}; # tracecall advice.

# The advice CROSSCUT multiple functions.
# What's the difference between the above and just writing new versions
# of gcd and fact?  Because that won't affect existing code, which are
# still calling the original functions.  You want to CHANGE the behavior of
# the existing functions, but do so "locally".  This way of writing code
# was inspired by Aspect Oriented Programming.

# Advice to do output after calling
$advice_output = sub {
    my ($f,@params) = @_;    
    my $basegcd = $gcd;
    local $gcd = sub
    {   
	my $x = $basegcd->(@_);
	if ($_[0]==0) {println "gcd is ",$x}  
	$x;
    };
    my $basefact = $fact;
    local $fact = sub
    {
	my $x = $basefact->(@_);
	println("factorial is ",$x);
	$x;
    };

    $f->(@params);  # run target program under advice
};

# For those concerned with security: suppose there are functions with
# vulnerabilities, such as not checking if parameters are within valid
# range, and that these functions are already being used by software.
# Writing a new function would require you to change all code so that
# the new function is called instead of the old one, but you might not
# even have access to other source code.  Again, you want to CHANGE
# the behavior of the function so whoever calls it will get the
# benefit of your sagely advice:

$advice_checkparams = sub {
    my ($f,@params) = @_;    
    my $basegcd = $gcd;
    local $gcd = sub
    {   
	if ($#_<1)
	{println "bad args passed to gcd"}
	else {$basegcd->(@_)}
    };
    my $basefact = $fact;
    local $fact = sub
    {
	if ($#_<0 || $_[0]<0)
    	{println "bad args passed to fact"}
	else {$basefact->(@_);}
    };

    $f->(@params);  # run target program under advice    
};

$main = sub   # there's no main in perl, so this is just some function.
{
    $gcd->(30,20);
    $fact->(5);
    $gcd->(2); # not enough parameters!
    $fact->(-2);  # not defined.
};

println("--------------");
$main->();  # nothing happens
println("--------------");

&{$advice_tracecall}($main); # same as $advice_tracecall->($main)
println("--------------");

$advice_output->($main);  # run main under different advice
println("--------------");

$advice_output->($advice_tracecall,$main);  # run under multiple advice

println("--------------");

$advice_output->($advice_tracecall,$advice_checkparams,$main);
# order of call determines precedence of advice

println("--------------");

$advice_output->($advice_checkparams,$advice_tracecall,$main);
