package Conway;
use overload
'+'     => \&Add,
'-'     => \&Sub,
'*'     => \&Mul,
'>='    => \&Geq,
'<='    => \&Leq,
'=='    => \&eql,
'<=>'   => \&Cmp,
'neg'   => \&Neg,
'++'    => \&Succ,
'""'    => \&Name,
'0+'    => \&Value,
'='     => \&Copy,
bool    => sub{my $x = shift; return !Eql($x,$zero)},
;

sub Geq{
    my($x,$y) = @_;
    my @xL = @{$x->[0]};
    my @xR = @{$x->[1]};
    my @yL = @{$y->[0]};
    my @yR = @{$y->[1]};
    return !(grep{Leq($_,$y)}@xR) && !(grep{Leq($x,$_)}@yL);
}
sub Leq{
    my($x,$y) = @_;
    return Geq($y,$x);
}
sub Eql{
   my($x,$y) = @_;
   return Geq($x,$y) && Geq($y,$x)
}
sub Gtr{
   my($x,$y) = @_;
   return Geq($x,$y) && !Geq($y,$x);
}
sub Cmp{
   my($x,$y) = @_;
   my $g = Geq($x,$y);
   my $l = Leq($x,$y);
   return undef unless $g || $l;
   return  0 if $g &&  $l;
   return  1 if $g && !$l;
   return -1 if !$g && $l
}
sub Neg{
   my $x = shift;
   my @xL = @{$x->[0]};
   my @xR = @{$x->[1]};
   
   return bless [
     [map{Neg($_)}@xR], 
     [map{Neg($_)}@xL]
   ];
}
sub Add{
    my($x,$y) = @_;
    my @xL = @{$x->[0]};
    my @xR = @{$x->[1]};
    my @yL = @{$y->[0]};
    my @yR = @{$y->[1]};
    bless[
     [
        (map{Add($_,$y)} @xL),
        (map{Add($x,$_)} @yL),
     ],
     [
        (map{Add($_,$y)} @xR),
        (map{Add($x,$_)} @yR),
     ]
    ];
 }
sub Sub{
    my($x,$y) = @_;
    Add($x,Neg($y));
}
sub dmap(&$$){
        my $f = shift;
        my @a = @{shift @_};
        my @b = @{shift @_};
        map{
            local $a = $_;
            map{ local $b=$_; &$f } @b;
        } @a;
}
sub Mul{
   my($x,$y) = @_;
   my @xL = @{$x->[0]};
   my @xR = @{$x->[1]};
   my @yL = @{$y->[0]};
   my @yR = @{$y->[1]};
   bless [
      [
         (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xL,\@yL),
         (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xR,\@yR),
      ],
      [
         (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xL,\@yR),
         (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xR,\@yL),
      ]
   ]
}
sub L{
   my $x = shift;
   return @{$x->[0]};
};
sub R{
   my $x = shift;
   return @{$x->[1]};
}
sub normalize{
  my($x,$y) = @_;
  my @xL = map{normalize($_)} @{$x->[0]};
  my @xR = map{normalize($_)} @{$x->[1]};
  
  while( @xR > 1 ){
    if( Geq(@xR[0],@xR[-1]) ){
      shift @xR; 
    }elsif( Geq(@xR[-1],@xR[0]) ){
      pop @xR;
    }else{
       warn "NaN"; last;
    }
  }
  while( @xL > 1 ){
    if( Geq(@xL[0],@xL[-1]) ){
      pop @xL; 
    }elsif( Geq(@xL[-1],@xL[0]) ){
      shift @xL;
    }else{
       warn "NaN"; last;
    }
  }
  bless [[@xL],[@xR]];
}
sub Succ{
   my $x = shift;
   bless [[$x],[]];
}
sub Copy{
   my $x = shift;
   normalize($x);
}
sub new{
    my $class = shift;
    my ($L, $R) = @_;
    my $n = [$L,$R];
    bless $n,$class;
    return $n;
}
sub Name{
   my $x = shift;
#  return 0 if Eql($x,$zero);
   my @xL = @{$x->[0]};
   my @xR = @{$x->[1]};
   my $L=join",",map{Name($_)} @xL;
   my $R=join",",map{Name($_)} @xR;
   return "{$L|$R}";
}

sub Value{
   my $x = normalize(shift);
   my $g = Geq($x,$zero);
   my $l = Leq($x,$zero);
   return NaN unless $g || $l;
   return 0 if $g && $l;
   return -Value(Neg($x)) if $l && !$g;
   return 1+Value(Sub($x,$one) ) if( Geq($x,$one));
   return Value( Mul($x,$two) )/2;
}
$zero = new Conway [],[]; 
$one = $zero->Succ; 


$two = $one+$one;
#print "$one+$one=$two\n";
#print Value($one),"+",Value($one),"=",Value($two),"\n";
$two = normalize($two);
#print "$one+$one=$two\n";
#print Value($one),"+",Value($one),"=",Value($two),"\n";

print "$two+$two=",$two+$two,"\n";
print Value($two),"+",Value($two),"=",Value($two+$two),"\n";

#print Value(Mul($two,$two)),"\n";
#print Value([[$zero],[$one]]),"\n";

1;