I suppose I'd parse the expression into some kind of tree structure of objects along the lines of:

role Node;

class Conjunction with Node {
   has left  => (is => 'ro', does => 'Node');
   has right => (is => 'ro', does => 'Node');
}

class Disjunction with Node {
   has left  => (is => 'ro', does => 'Node');
   has right => (is => 'ro', does => 'Node');
}

class Negation with Node {
   has negated_term => (is => 'ro', does => 'Node');
}

class Primative with Node {
   has label => (is => 'ro', isa => Str);
}

my $fred = Primative->new(label => "Fred");
my $john = Primative->new(label => "John");
my $fred_and_john = Conjunction->new(left => $fred, right => $john);
...;
[download]

Then I'd write a few "visitor" rules that can take a tree and tweak it, for example, finding a candidate for rewriting under De Morgan's laws...

my $demorgans_laws = sub
{
   my $tree = $_[0];
   
   if ($tree->isa('Conjunction')
   and $tree->left->isa('Negation')
   and $tree->right->isa('Negation'))
   {
      return Negation->new(
         node => Disjunction->new(
            left => $tree->left->negated_term,
            right => $tree->right->negated_term,
         ),
      );
   }
   
   if ($tree->isa('Disjunction')
   and $tree->left->isa('Negation')
   and $tree->right->isa('Negation'))
   {
      return Negation->new(
         node => Conjunction->new(
            left => $tree->left->negated_term,
            right => $tree->right->negated_term,
         ),
      );
   }
   
   return $tree;
};
[download]

Then use some kind of hill-climbing algorithm to apply the tweaking rules to the tree, creating new trees; discarding trees that become more complex than the original, and retaining trees that become simpler, or at least as simple.

The problem with hill-climbing is that you can find local maxima. If you're climbing a mountain, sometimes you find a small peak, and you need to climb downwards a bit before you can reach the true summit. This is a hard problem to solve without ending up with a completely undirected search. But luckily, it's a problem that many smart people have thought about, so there's a wealth of ideas on how to solve it if you delve into AI literature.

In order to come up with the minterms, you would need a value table. Here is some code to find the variables and the value table:

use strict;
use warnings;

$"="\t";
my $bool = 'Fred&Teddy&(Fred|Teddy)|(Fred)&(John)';
my @vars = keys %{{ map { $_ => 1 } $bool =~ /\b(\w+)\b/g }};
$bool =~ s/($_)/\$b\{${1}\}/g for @vars;
my $n = @vars;

my %b;
print "@vars\tValue\n";
for (0..2**$n-1) {
    @b{@vars} = split //, sprintf "%0${n}b", $_;
    print "@b{@vars}\t";
    print eval $bool;
    print "\n";
}
[download]

Here is a complete solution which uses Algorithm::QuineMcCluskey (this module throws a number of warnings but seems to work). I only tested it on your one expression, so if you are using it, let me know whether it works well or not.

use strict; 
use warnings; 
use List::Util 'sum'; 
use Algorithm::QuineMcCluskey;

my $bool = 'Fred&Teddy&(Fred|Teddy)|(Fred)&(John)'; 
my @vars = keys %{{ map { $_ => 1 } $bool =~ /\b(\w+)\b/g }}; 
$bool =~ s/($_)/\$b\{${1}\}/g for @vars; 
my $n = @vars; 
my @table; 
my %b; 
for (0..2**$n-1) { 
  @b{@vars} = split //, sprintf "%0${n}b", $_; 
  push @table, $_ if eval $bool; 
} 

my $q = new Algorithm::QuineMcCluskey( width => $n, minterms => \@tabl
+e );
my( $result )= $q->solve();
$result =~ s/\+/|/g;
$result =~ s/([A-Z])'/!$1/g;
$result =~ s#([A-Z]+)# join( "&", map { $vars[ord($_)-ord("A")] } spli
+t //, $1 ) #ge;
print "$result\n";
[download]

Update: I could not help playing a little with this code. If one uses the vec function instead of a hash for the variables, one can shorten the code to:

use strict; 
use warnings; 
use Algorithm::QuineMcCluskey;

my $bool = 'Fred&Teddy&(Fred|Teddy)|(Fred)&(John)'; 
my @vars = keys %{{ map { $_ => 1 } $bool =~ /\b(\w+)\b/g }}; 
$bool =~ s/$vars[-$_]/vec(\$_,$_-1,1)/g for 1..@vars; 

my($result) = Algorithm::QuineMcCluskey->new( 
                                             width => scalar @vars, 
                                             minterms => [ grep { eval
+ $bool } 0..2**@vars-1 ] 
                                            )->solve();
$result =~ s/\+/|/g;
$result =~ s/([A-Z])'/!$1/g;
$result =~ s#([A-Z]+)# join( "&", map { $vars[ord($_)-ord("A")] } spli
+t //, $1 ) #ge;
print "$result\n";
[download]

Do a search for "Karnaugh maps".

RESULT = Fred&Teddy&(Fred|Teddy)|(Fred)&(John)
RESULT now should contain
RESULT = (Fred&John)|(Teddy&Fred&John)
[download]