Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

annotation, derivation

by hv (Parson)
on Feb 17, 2012 at 08:55 UTC ( #954455=perlquestion: print w/replies, xml ) Need Help??

hv has asked for the wisdom of the Perl Monks concerning the following question:

For a work problem I encountered yesterday, it occurred to me that it'd be trivial to solve with the right helper module. I can't work out if that module is easy, hard or impossible to write - or has already been written.

I'm slightly fuzzy on the details, but I imagine it looking something like this:

% cat myprog use Data::Annotate; # 'Tie::Annotate'? sub adder { return $_[0] + $_[1] } my($foo, $baz) = (2, 5); annotate($foo, 'foo'); my $bar = adder($foo, $baz); say "bar is ", $bar; say "bar is annotated as ", annotation($bar); say "bar is derived from ", derivation($bar); # not sure if that should also attempt to show derivation of the # components; maybe it should take a maxdepth argument: my $etc = $bar + $foo; say "etc is annotated as ", annotation($etc); say "etc is derived from ", derivation($etc, depth => 3); % perl myprog bar is 7 bar is annotated as foo + 5 bar is derived from foo + 5 at myprog line 2 main::adder(2, 5) called at myprog line 5 etc is annotated as (foo + 5) + foo etc is derived from (foo + 5) + foo at myprog line 11 (foo + 5) at myprog line 2 main::adder(2, 5) called at myprog line 5 foo annotated at myprog line 4 %

An obvious difficulty is how to construct the annotation string for various ops, but I'd be happy enough if it said "i_add(i_add(foo, 5), foo)" instead.

I'd welcome your thoughts.


Replies are listed 'Best First'.
Re: annotation, derivation
by moritz (Cardinal) on Feb 17, 2012 at 09:09 UTC

    The obvious approach is to create objects that hold both the value and the annotation, and to overload all interesting operations on these objects:

    use 5.010; # just for say(); use strict; use warnings; { package Annotated; sub new { my $class = shift; bless \@_, $class; } sub value { $_[0][0] }; sub annotation { $_[0][1] }; use overload '+' => sub { Annotated->new( $_[0]->value + $_[1]->value, "(" . $_[0]->annotation . ' + '. $_[1]->annotation. ')' ); } } my $foo = Annotated->new(2, 'foo'); my $bar = Annotated->new(5, 'bar'); say +($foo + $bar)->value; say +($foo + $bar)->annotation; __END__ 7 (foo + bar)

    That might get hairy when you want to consider operations with non-annotated values, and it's a lot of work to overload all operators (though most of that can be automated

    Apart from that I could only think of a custom perl runcore that traces annotations, but I wouldn't be the one to write such a core.

Re: annotation, derivation
by tobyink (Canon) on Feb 17, 2012 at 10:18 UTC

    The following handles basic maths. It should be fairly obvious how to extend it to cover other mathematical operations.


    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__

    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;


    $quux is 2 $quux was calculated as ((2 (($foo + $bar) - 1)) mod $foo) $quux is now 4 $quux was calculated as ($quux 2)

      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.

      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.



        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.

Re: annotation, derivation
by Your Mother (Archbishop) on Feb 17, 2012 at 14:30 UTC

    This seems like a poor match for what you describe, it's still interesting and in the problem space so you might take a look: dualvar.

Re: annotation, derivation
by run4flat (Initiate) on Feb 17, 2012 at 15:19 UTC

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://954455]
Approved by moritz
Front-paged by moritz
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (3)
As of 2021-12-04 20:39 GMT
Find Nodes?
    Voting Booth?
    R or B?

    Results (30 votes). Check out past polls.