#!/usr/bin/perl
#################################################
#
# Overloading the ++ operator 
# with routines that print out diagnostics
# in an attempt to understand the weird behavior of (++$m + $m++).
#
# This code follows the examples in chap 13 of Camel book 
# (Programming Perl, 3d Ed, Wall, Christiansen, Orwant).
#
# See ./quantum_weirdness.txt for an explanation of 
# what this is for and why.
#
# Jim Mahoney 
# Marlboro College
# mahoney@marlboro.edu
#
# Copywright 2004.  This program is free software; you may 
# redistribute it and/or modify it under the same terms as Perl itself.
######################################################################

package IncrementOverload;
use 5.005;
use strict;
use warnings;
our $VERSION = '0.3'; # June 9 2004
# use Exporter;
# our @ISA = qw( Exporter );

our $m = IncrementOverload->new;           # Printed out during evaluation

use overload  
  '""'  => \&as_string,
  '++'  => \&increment,
  '='   => \&copy,
  '+'   => \&add,
  ;

sub new {
  my $class = shift;
  my $hash  = { value => shift || 0 };     # Default value is 0.
  my $address = $hash;                     # Do this *before* blessing,
  for ($address){                          #   or use overload::StrVal;
    s/.*\(//;   # remove chars up to (     #   see camel pg 360.
    s/\).*//;   # remove trailing )
  }
  $hash->{address} = $address;              
  return bless $hash => $class;
}

sub add {
  my ($x, $y) = @_;
  my $xvalue = ref($x) ? $x->{value} : $x;
  my $yvalue = ref($y) ? $y->{value} : $y;
  my $sum = IncrementOverload->new( $xvalue + $yvalue );
  print "  *** add : $x + $y = $sum \n";
  print "       m is $m \n";
  return $sum;
}

sub copy {
  my $self = shift;
  my $copy = IncrementOverload->new( $self->{value} );
  my ($selfaddress, $copyaddress) = ( $self->{address}, $copy->{address} );
  print "  *** copy $selfaddress --> $copyaddress \n";
  print "       m is $m \n";
  return $copy;
}

sub increment {
  my $self = shift;
  my ($selfaddress, $value) = ($self->{address}, $self->{value});
  my $valueplus1 = $value+1;
  $self->{value} = $valueplus1;
  print "  *** inc  $selfaddress : $value --> $valueplus1 \n";
  print "       m is $m \n";
}

sub as_string {
  my $self = shift;
  return $self->{value} . " at ". $self->{address};
}

# =============================================================

if (not caller){                           # if invoked from shell
  my ($alpha, $beta, $gamma, $p, $c);

  sub noop{ return shift }
  print "\n";

  print "==== simple increment ======== \n";
  $alpha = IncrementOverload->new(20);
  print " alpha  = $alpha \n";
  print " incrementing alpha. \n";
  $alpha++;
  print " alpha  = $alpha \n\n";

  print "==== second variable with same value; increment one =====\n";
  $alpha = IncrementOverload->new(20);
  print " alpha  = $alpha \n";
  print " beta = alpha \n";
  $beta = $alpha;
  print " beta = $beta \n";
  print " incrementing alpha. \n";
  $alpha++;
  print " alpha = $alpha \n";
  print " beta = $beta \n\n";

  print "==== simple addition ==============\n";
  $alpha = IncrementOverload->new(20);
  print " alpha  = $alpha \n";
  $beta = IncrementOverload->new(30);
  print " beta  = $beta \n";
  print " gamma = alpha + beta \n";
  $gamma = $alpha + $beta;
  print " gamma = $gamma \n\n";

  print "==== increment weirdness: ++\$m + \$m++ ==========\n";
  $m=IncrementOverload->new(20);
  print " m = $m \n";
  print " p = ++m + m++ \n";
  $p = ++$m + $m++;
  print " p = $p \n\n";

  print "==== different with noop: noop(++\$m) + \$m++ =====\n";
  $m=IncrementOverload->new(20);
  print " m = $m \n";
  print " p = noop(++m) + m++ \n";
  $p = noop(++$m) + $m++;
  print " p = $p \n\n";

  print "==== a second name for m : ++\$m + \$m++ ======== \n";
  $m=IncrementOverload->new(20);
  print " m = $m \n";
  print " c = m \n";
  $c = $m;
  print " c = $c \n";
  print " p = ++m + m++ \n";
  $p = ++$m + $m++;
  print " p = $p \n\n";

}


1;

__END__
====================================================================


$ ./IncrementOverload.pm 

==== simple increment ======== 
 alpha  = 20 at 0x80a79cc 
 incrementing alpha. 
  *** inc  0x80a79cc : 20 --> 21 
       m is 0 at 0x804c00c 
 alpha  = 21 at 0x80a79cc 

==== second variable with same value; increment one =====
 alpha  = 20 at 0x80a9958 
 beta = alpha 
 beta = 20 at 0x80a9958 
 incrementing alpha. 
  *** copy 0x80a9958 --> 0x80abb20 
       m is 0 at 0x804c00c 
  *** inc  0x80abb20 : 20 --> 21 
       m is 0 at 0x804c00c 
 alpha = 21 at 0x80abb20 
 beta = 20 at 0x80a9958 

==== simple addition ==============
 alpha  = 20 at 0x80a9808 
 beta  = 30 at 0x80abce8 
 gamma = alpha + beta 
  *** add : 20 at 0x80a9808 + 30 at 0x80abce8 = 50 at 0x80a9640 
       m is 0 at 0x804c00c 
 gamma = 50 at 0x80a9640 

==== increment weirdness: ++$m + $m++ ==========
 m = 20 at 0x80abbd4 
 p = ++m + m++ 
  *** inc  0x80abbd4 : 20 --> 21 
       m is 21 at 0x80abbd4 
  *** copy 0x80abbd4 --> 0x804c0c0 
       m is 21 at 0x80abbd4 
  *** inc  0x804c0c0 : 21 --> 22 
       m is 22 at 0x804c0c0 
  *** add : 22 at 0x804c0c0 + 21 at 0x80abbd4 = 43 at 0x80abc64 
       m is 22 at 0x804c0c0 
 p = 43 at 0x80abc64 

==== different with noop: noop(++$m) + $m++ =====
 m = 20 at 0x80abba4 
 p = noop(++m) + m++ 
  *** inc  0x80abba4 : 20 --> 21 
       m is 21 at 0x80abba4 
  *** copy 0x80abba4 --> 0x80a97d8 
       m is 21 at 0x80abba4 
  *** inc  0x80a97d8 : 21 --> 22 
       m is 22 at 0x80a97d8 
  *** add : 21 at 0x80abba4 + 21 at 0x80abba4 = 42 at 0x80a799c 
       m is 22 at 0x80a97d8 
 p = 42 at 0x80a799c 

==== a second name for m : ++$m + $m++ ======== 
 m = 20 at 0x804c138 
 c = m 
 c = 20 at 0x804c138 
 p = ++m + m++ 
  *** copy 0x804c138 --> 0x80a988c 
       m is 20 at 0x804c138 

syntax highlighted by Perl::Tidy 20060719