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__