# "Subversive" uses of dynamic scoping.

# Static scoping is generally preferred over dynamic scoping: a
# dynamically scoped variable can have a global effect, depending on
# the name we give the variable.  Dynamically scoped variables also
# cannot be used to form closures. Under dynamic scoping I can alter
# the behavior of existing functions by just giving "local" variables certain
# names, violating the self-contained, "black-box" nature of functions.
# Dynamic scoping is not much different from using only global variables.

# So when is dynamic scoping useful?  When altering the behaviors of existing
# functions IS EXACTLY WHAT YOU WANT TO DO. 


$gcd = sub {
    my ($a,$b) = @_; # return gcd of a and b
    while ($a!=0 && $b!=0)
    {
	if ($a>$b) { $a=$a%$b; }
	else { $b = $b%$a; }
    }
    $a+$b # return value must be non-zero.
};
# problem: gcd(0,0) is undefined, should not return 0.


$fib = sub{};  # dummy initial def to allow recursion
$fib = sub {
    my $n = $_[0];
    if ($n<3) {1} else {$fib->($n-1) + $fib->($n-2)}
};

# print $fib->(100);   # uncomment at your own risk


# function to return x**n % m
sub modpower {
    my ($x,$n,$m) = @_;
    my $ax = 1; # accumulator
    while ($n-- > 0) { $ax = ($ax * $x) % $m }
    $ax
} #modpower

$modexpt = \&modpower;  # make it a pointer

#print $modexpt->(2,9,1000), "\n";  # should be 512

# should be 4 digits but might take a while:
#print $modexpt->(2,100000000,10000), "\n";  


sub main {
    $gcd->(12,8);
    $gcd->(0,0);
    $fib->(-1);
    $fib->(10);
    $modexpt->(2,9,1000), "\n";  # should be 512    
    # should be 4 digits but might take a while:
    $modexpt->(2,100000000,10000), "\n";
    $fib->(100)  # this will take even longer...
} # are there any free variables in main?

########## We need to work on different ASPECTS of these programs

# parameter checks:

# trace, user IO

# optimization

# main();  # main called without any "advice"

### function to take function and make a traced version of it, provides
### output
sub maketrace { # pass in string name, pointer, and option to race recursion
    my ($fname,$fpointer,$trace_recursion) = @_; 
    my $call_level = 0;  # controls tracing of recursive functions
    sub {  # lambda to return
      if ($call_level==0 || $trace_recursion) {
	  print "$fname called on ",join(",",@_), "\n";
      }
      $call_level++;
      my $result = $fpointer->(@_);
      $call_level--;
      if ($call_level==0 || $trace_recursion) {
	  print "$fname returned $result\n";
      }
      $result
    } # function to return
} # maketrace

$gcdt = maketrace("gcd",$gcd,0);
#$gcdt->(10,8);
# But this won't affect main, or other functions that already call $gcd
# $gcd = maketrace("gcd",$gcd,0); 
# But this changes $gcd permanently! don't want that.
# What to do? USE DYNAMIC SCOPING!

sub advice_trace {
  # crucial use of call-by-reference: $_[0] = .. will change original function
  my ($target,@args) = @_; # target is a pointer to a function
  my $gcd_base = $gcd;  # save original
  local $gcd = maketrace("gcd",$gcd_base,0);

  ### don't just want to change gcd, because "trace" CROSSCUT other functions
  local $fib = maketrace("naive fib",$fib,0);
  local $modexpt = maketrace("mod power",$modexpt,0);

  $target->(@args);  # calls target function under advice  (and return result)
  
} # advice_trace
#### why wouldn't this work with my instead of local?


#### SEPARATION OF CONCERN IN PROGRAMMING
## Modularize program around "aspect" instead of around function or data

#### advice to check arguments for boundary conditions
sub advice_checkargs {
    my ($target,@args) = @_; # target is a pointer to a function    
    my $fib_base = $fib;
    local $fib = sub {
	if ($_[0] < 1) {"UNDEFINED"}
	else {$fib_base->(@_)}  # carefule, can't refer to $fib here
    };
    my $gcd_base = $gcd; # must be my to refer to original $gcd
    local $gcd = sub {
	if ($_[0]==0 && $_[1]==0) {"UNDEFINED"}
	else {$gcd_base->(@_); }
    };
    $target->(@args)
}

# this advice will cancel other advice because it doesn't call base version
sub advice_optimize {
    my ($target,@args) = @_;
    local $fib = sub {
	my ($n,$a,$b) = ($_[0],1,1);
	while ($n-- > 1) { ($a,$b) = ($b,$a+$b); }
	$b;
    };
    local $modexpt = sub {
	my ($x,$n,$m) = @_;
	my ($ax,$factor) = (1,$x%$m);
	while ($n>0)
	{
	    if ($n%2==1) { $ax = ($ax * $factor) % $m; }
	    $factor = ($factor*$factor)%$m;
	    $n = $n/2; # shift to next bit
	}#while
	$ax
    };
    $target->(@args)    
} # optimization advice

# main()   # run without any advice (free version)

# execute main under advice:   (home version)
#advice_trace(\&main);  # too slow because of fib

# multiple advice  (pro version)
#advice_checkargs(\&advice_trace,\&main);

#advice_trace(\&advice_checkargs,\&main);  #trace canceled if undefined
#### inner advice may override outer advice

#advice_optimize(\&advice_trace,\&main);
#WEAVING
# The "ultimate version" - all available advice
advice_optimize(\&advice_checkargs,\&advice_trace,\&main);

$main2 = sub  {
    print $fib->($_[0])+$fib->($_[1])+$gcd->(12,8)+$modexpt->(2,5,1024),"\n" };

advice_optimize(\&advice_checkargs,\&advice_trace,$main2,11,12);

# Aspect Oriented Programming.
# AspectJ
    
