Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re: annotation, derivation

by tobyink (Canon)
on Feb 17, 2012 at 10:18 UTC ( [id://954495]=note: print w/replies, xml ) Need Help??


in reply to annotation, derivation

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(\&divide, @_) }, '%' => 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)

Replies are listed 'Best First'.
Re^2: annotation, derivation
by tobyink (Canon) on Feb 17, 2012 at 10:31 UTC

    PS: by playing around with Devel::Declare is ought to also be possible to replace code like this:

    my $foo = an(5, '$foo');

    With something more like:

    annotated $foo = 5;

    Devel::Declare allows you to hook into the Perl parser to catch keywords and add custom parsing for them. In this case, you'd catch the keyword annotated and rewrite it to something like:

    annotated(); my $foo = Scalar::Annotated->new(0, '$foo'); $$foo = 5;

    Thus people could use annotated in much the same way as they currently use my, local or our.

Re^2: annotation, derivation
by hv (Prior) on Feb 17, 2012 at 14:04 UTC

    Cool, that looks very much like what I hoped for, I'll have to have a play to see if I can find a sensible way to record and expose the locations and stacktraces at which the calculations occur.

    Getting the information to survive across transitions to string and back may be harder: in fact, I suspect sensible string support will generally be rather harder (eg to extract the interesting information from something like $string = join ', ', @substrings).

    I wouldn't have gone for an lvalue derivation(), but I think that's more an issue of personal style.

    Thanks,

    Hugo

      Object::Stash is written in such a way that, the accessors can be used as lvalues, or getter/setters:

      $quux->derivation = 'x'; $quux->derivation('x');

      ... are both equivalent.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://954495]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (3)
As of 2024-03-28 18:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found