#!/bin/perl

# pattern matching tests:


# hash table basics
my %ht = (me,1,"you",2);

print $ht{me}, "\n";
print $ht{you}, "\n";
$ht{me} = 4;
$ht{her} = 9;
print $ht{me}, "\n";
print $ht{her}, "\n";


my ($key,$val) = each(%ht);
print $val, "\n--------\n";


$ht{ff} = sub{$_[0] + $_[0]};
print $ht{ff}->(4) , "\n";


$ht{"z.z"} = 100;

sub patfind 
{  
    my ($pat,%hash) = @_;
    foreach $ent (keys %hash) 
      { if ($pat =~ /$ent/) 
	  { return $hash{$ent}; }
      }
    die "no pattern matches";
}

print &patfind(her,%ht), "\n";
print &patfind(zbz,%ht), "\n";

#$pat = hi;  $c = 3;
#print "test dfsf ", $pat.++$c, "\n";   # worked

sub patfindi   # indexed
{   my $c=0;
    my ($pat,%hash) = @_;
    foreach $ent (keys %hash) 
      { if ($pat.$c++ =~ /$ent/) 
	  { return $hash{$ent}; }
      }
    die "no pattern matches";
}

#foreach (keys %ht) {print $_ , "\n"; }
#while (($person, $age) = each(%ht))
#{
#        print "$person is $age\n";
#}


$htt{abc,edf} = 4;
my ($rr,$rrr,$ddd) = (each %htt);
print "multikey ", $rr, " and ", $rrr, "\n";
# cool!



# towards hashed functions:

my $body = '$_[0] * $_[0]';
my $f = sub { eval $body };
print $f->(4), "\n";

#
my $rr = { a => 1, b => 2 };
print $rr->{b}, "\n";  # same as $$rr{b}


sub app { my ($f,@args) = @_;   # get hastable and args
	  my $hkey = join ",",@args;
          #print $hkey, "\n";
	  my $func = patfind($hkey,%$f);  #need to join args
	  $func->(@args);
        }

# simple case

my $testf =
{
    1 => sub{5+$_[0]},
    2 => sub{5*$_[0]},
};

print app($testf,1),  "\n";
print app($testf,2),  "\n";   # worked!

my $fact;
$fact1 =
{ 1 => sub{1},
  "^" => sub{ my $n = shift;
              $n * app($fact,$n-1) 
            }
};

$fact->{1} = sub{1};
$fact->{'\d*'} = sub{ my $n=shift; if ($n>1) {$n * app($fact,$n-1)} };


print "fact - first attempt: ", app($fact,6),  "\n";

sub mksub1
  {
      my $fhash = $_[0];
      sub { app($fhash,@_) }
  }

my $factorial = mksub1($fact);
my $rr = 7;
print $factorial->($rr), "\n";

# algebraic data structures:

#my $list = "(cons 4 (cons 5 nil))";
#print $list , "\n";


# iterative fibonacci

my $ifib;

$ifib->{"0,[0-9]+,[0-9]+"} = sub { my ($n,$a,$b) = @_; $a };
$ifib->{"1,[0-9]+,[0-9]+"} = sub { my ($n,$a,$b) = @_; $b };
$ifib->{'\d+,\d+,\d+'} = 
   sub { my ($n,$a,$b) = @_; app($ifib,$n-1,$b,$a+$b) };

my $iterfib = mksub1($ifib);

#if ("1,0,1" =~ /1,\d+,\d+/) {print "yesyes!\n";}

print $iterfib->(1,0,1);  print "\n";
print $iterfib->(8,0,1);  print "\n---------\n";




my $rfib;  # rfib must be defined prior to use! or use global!

#foreach (keys %$fib) { print $_; }  print "\n";
#foreach (values %$fib) { print $_; }  print "\n";


$facthash->{'$n:$n<=1'} = 1;
$facthash->{'$n:$n>1'} = '$n * $factorial->($n-1)';

sub mkfun  # mkfun takes a hash table pointer like $fact and returns a sub
  {
      my $fhash = $_[0];
      my @cles = (keys %$fhash);
      my @vals = (values %$fhash);
      my @paramvars; my ($var0, $bool0);  
      sub { my $indp;
	    my $match0 = 0;  # boolean 
            my $counter0 = 0;
	    my @mykeys; my $val; my @vars; my $bool;
            my $funbody = 'print "no matches\n"'; # body 
	    my $varform;  my $preamble;
	    @paramvars = @_;
	    # print "actual params: ", join ',',@paramvars, "\n";
	    while ((!$match0) && (counter <= $#vals))
	    {
	       if ($#paramvars > 0) 
	           { @mykeys = split / *, */, $cles[$counter0]; }
	       else
                   { $mykeys[0] = $cles[$counter0]; }
	       # print "mykeys are ", join ',',@mykeys; print "\n";
               $val = $vals[$counter0++];  # function body for this case
	       $bool = '1';  $preamble = '';  # identities
	       for ($indp=0;$indp<=$#paramvars;$indp++)
               { $key = $mykeys[$indp];  # e.g., '$n:$n>1' or '1'
		 $varform = split /:/, $key;  # form of parameter
		 if ($varform < 2) # not in name var:boolean form
		      { $vars[$indp]="\$paramvars[$indp]"; 
                        $bool0="\$paramvars[$indp] eq $key";
		      }
	         else { ($vars[$indp],$bool0) = split /:/, $key; 
			$preamble = 
			  $preamble."my $vars[$indp] = \$paramvars[$indp]; ";
                      }
	         $var0 = $vars[$indp]; # don't change original
	         $var0 =~ s/\$/\\\$/;
  	          $bool0 =~ s{$var0}{\$paramvars[$indp]};
	         $bool = $bool." and ($bool0)";
	         $val =~ s{$var0}{(eval $vars[$indp])};
	       } #for $indp loop
	         # print "vars is ", @vars, ", bool is ", $bool; print "\n";
	       if (eval $bool) 
		 { $match0 = 1;
		   $funbody = "$preamble  $val";
	           # print "funbody is: ", $funbody; print "\n";
		 } # if
            } # while more cases
	    eval $funbody;
	  }  # returned sub 
   }  # mkfun


$factorial = mkfun($facthash);
print "the factorial of 6 is ", $factorial->(6), "\n";

# Rules for defining functions: a parameter can either be a constant
# or a $ variable followed by a :boolean expression.  If a parameter
# is a variable by itself, it will be resolved to a constant.  Do not
# use any of the "my" variables in mksub - they should be considered 
# reserved names.  It is assumed that the user will define each case
# of the function as taking the same number of parameters.

# Fibonacci function:

$fib->{0} = 0;
$fib->{1} = 1;
$fib->{'$n:$n>1'} = '$fib->($n-1) + $fib->($n-2)';

$fib = mkfun($fib);

#print $fib->(0);  print "\n";
#print $fib->(1);  print "\n";
print "fib(8) is ", $fib->(8);  print "\n";

# Euclid's algorithm:

$gcd->{'0, $m:$m>0'} = '$m';
$gcd->{'$n:$n>0, $m:true'} = '$gcd->($m%$n,$n)';

$gcd = mkfun($gcd);

#print $gcd->(4,0), "\n";
print "the gcd of 12 and 8 is ", $gcd->(12,8), "\n";



