The following handles basic maths. It should be fairly obvious how to extend it to cover other mathematical operations.
lib/Scalar/Annotated.pm
package Scalar::Annotated;
use 5.010;
use strict;
use utf8;
use Carp;
use Scalar::Util qw/looks_like_number blessed/;
sub _swap
{
my ($sub, $x, $y, $swap) = @_;
$swap ? $sub->($y, $x) : $sub->($x, $y);
}
sub _promote
{
map {
blessed($_) && $_->isa(__PACKAGE__)
? $_
: an($_)
} @_
}
use namespace::clean;
use parent qw/Exporter/;
use Object::AUTHORITY;
use Object::DOES;
use Object::Stash -type => 'object';
our ($AUTHORITY, $VERSION, @EXPORT);
BEGIN {
$AUTHORITY = 'cpan:TOBYINK';
$VERSION = '0.001';
@EXPORT = qw/an/;
}
sub new
{
my ($class, $value, $derivation) = @_;
croak "Needs to be a simple scalar" if ref $value;
$derivation //= looks_like_number($value) ? $value : "q{$value}";
my $self = bless \$value, $class;
$self->derivation = $derivation;
return $self;
}
sub an
{
return __PACKAGE__->new(@_);
}
sub derivation :lvalue
{
my $self = shift;
$self->stash->derivation(@_)
}
use overload
'+0' => sub { ${ $_[0] } },
q{""} => sub { ${ $_[0] } },
'+' => sub { _swap(\&add, @_) },
'-' => sub { _swap(\&subtract, @_) },
'*' => sub { _swap(\&multiply, @_) },
'/' => sub { _swap(\÷, @_) },
'%' => sub { _swap(\&modulus, @_) },
;
sub add
{
my ($x, $y) = _promote(@_);
return an(
$$x + $$y,
sprintf('(%s + %s)', $x->derivation, $y->derivation),
);
}
sub subtract
{
my ($x, $y) = _promote(@_);
return an(
$$x - $$y,
sprintf('(%s - %s)', $x->derivation, $y->derivation),
);
}
sub multiply
{
my ($x, $y) = _promote(@_);
return an(
$$x * $$y,
sprintf('(%s × %s)', $x->derivation, $y->derivation),
);
}
sub divide
{
my ($x, $y) = _promote(@_);
return an(
$$x / $$y,
sprintf('(%s ÷ %s)', $x->derivation, $y->derivation),
);
}
sub modulus
{
my ($x, $y) = _promote(@_);
return an(
$$x % $$y,
sprintf('(%s mod %s)', $x->derivation, $y->derivation),
);
}
__PACKAGE__
example.pl
use 5.010;
use strict;
use utf8::all;
use lib "lib";
use Scalar::Annotated;
my $foo = an(5, '$foo');
my $bar = an(2, '$bar');
my $baz = 2 * ($foo + $bar - 1);
my $quux = $baz % $foo;
say '$quux is ', $quux;
say '$quux was calculated as ', $quux->derivation;
# Reset the derivation of $quux, because we are no longer
# interested in how it was derived.
$quux->derivation = '$quux';
$quux *= 2;
say '$quux is now ', $quux;
say '$quux was calculated as ', $quux->derivation;
Output
$quux is 2
$quux was calculated as ((2 × (($foo + $bar) - 1)) mod $foo)
$quux is now 4
$quux was calculated as ($quux × 2)
|