Object, roles and multiple dispatch - roles

I'm trying to use multiple dispatch to overload and use methods within composed classes. Here's the implementation:
role A {
has $!b;
submethod BUILD( :$!b ) {}
multi method bar () {
return $!b;
}
}
class B does A {
submethod BUILD( :$!b ) {}
multi method bar() {
return " * " ~ callsame ~ " * ";
}
}
my $a = A.new( b => 33);
say $a.bar();
my $b = B.new( b => 33 );
say $b.bar();
This fails, however, with:
Calling callsame(Str) will never work with declared signature ()
(I really have no idea why callsame uses Str as a signature). Changing the method bar to use callwith:
multi method bar() {
return " * " ~ callwith() ~ " * ";
}
Simply does not work:
Use of Nil in string context
in method bar at multi.p6 line 18
* *
Is there any special way to work with call* within roles/classes?

The first issue is a matter of syntax. A listop function call parses an argument list after it, starting with a term, so this:
return " * " ~ callsame ~ " * ";
Groups like this:
return " * " ~ callsame(~ " * ");
And so you're calling the ~ prefix operator on " * ", which is where the Str argument it complains about comes from.
Ultimately, however, the issue here is a misunderstanding of the semantics of role composition and/or deferral. Consider a non-multi case:
role R { method m() { say 1; callsame() } }
class B { method m() { say 2; callsame() } }
class C is B does R { method m() { say 3; callsame(); } }
C.m
This outputs:
3
2
Notice how 1 is never reached. This is because role composition is flattening: it's as if the code from the role were put into the class. When the class already has a method of that name, then it is taken in favor of the one in the role.
If we put multi on each of them:
role R { multi method m() { say 1; callsame() } }
class B { multi method m() { say 2; callsame() } }
class C is B does R { multi method m() { say 3; callsame(); } }
C.m
The behavior is preserved:
3
2
Because the role composer accounts for the long name of the multi method - that is, accounting for the signature. Since they are the very same, then the one in the class wins. Were it to retain both, we'd end up with the initial call resulting in an ambiguous dispatch error!
Deferral with nextsame, callsame, nextwith, and callwith all iterate through the possible things we could have dispatched to.
In the case of a non-multi method, that is achieved by walking the MRO; since the method from the role was not composed, then it doesn't appear in any class in the MRO (nothing that only classes appear in the MRO, since roles are flattened away at composition time).
In the case of a multi method, we instead walk the set of candidates that would have accepted the arguments of the initial dispatch. Again, since the identically long-named method in the class was chosen in favor of the role one at composition time, the one from the role simply isn't in consideration for the dispatch in the first place: it isn't in the candidate list of the proto, and so won't be deferred to.

Related

Get method called-as str in the callee

I would like to introspect the tail end of a method call from the callee side.
Right now I am doing this explicitly...
# caller side
s.pd: '.shape';
s.pd: '.to_json("test.json")';
s.pd: '.iloc[2] = 23';
# callee side
method pd( Str $call ) {
given $call {
when /shape/ { ... }
when /to_json/ { ... }
#etc
}
}
BUT, I would like to do this by way of a 'slang method call', something like this made up code...
# caller side
s.pd.shape;
s.pd.to_json("test.json");
s.pd.iloc[2] = 23;
^ ^^ ^^^^^^^^^^^^^^^^^^^$
| | |
| | L a q// str I can put into eg. a custom Grammar
| |
| L general method name
|
L invocant
#callee side
method pd( ?? ) {
my $called-as-str = self.^was-called-as;
say $called-as-str; #'pd.to_json("test.json")'
...
}
(HOW) can this be done in raku?
Since there are 422 calls to handle, of many arity patterns, answers that require the declaration of 422 methods and signatures in the called Class will be less attractive.
Per #jonathans comment, the raku docs state:
A method with the special name FALLBACK will be called when other
means to resolve the name produce no result. The first argument holds
the name and all following arguments are forwarded from the original
call. Multi methods and sub-signatures are supported.
class Magic {
method FALLBACK ($name, |c(Int, Str)) {
put "$name called with parameters {c.raku}" }
};
Magic.new.simsalabim(42, "answer");
# OUTPUT: «simsalabim called with parameters ⌈\(42, "answer")⌋␤»
So my code example would read:
# callee side
class Pd-Stub {
method FALLBACK ($name, Str $arg-str ) {
say "$name called with args: <<$arg-str>>"
}
}
class Series {
has Pd-Stub $.pd
}
my \s = Series.new;
# caller side
s.pd.shape; #shape called with args: <<>>
s.pd.to_json("test.json"); #to_json called with args: <<test.json>>
s.pd.iloc[2] = 23; #iloc called with args: <<>>
#iloc needs to use AT-POS and Proxy to handle subscript and assignment

Assigning values to attributes in the BUILD phaser for an object

When a BUILD phaser is called, it overrides default attribute assignment in Perl6. Suppose we have to use that BUILD phaser, like we do in this module (that's where I met this problem). What's the way of assigning values to attributes in that phase?
I have used this
class my-class {
has $.dash-attribute;
submethod BUILD(*%args) {
for %args.kv -> $k, $value {
self."$k"( $value );
}
}
};
my $my-instance = my-class.new( dash-attribute => 'This is the attribute' );
And I get this error
Too many positionals passed; expected 1 argument but got 2
Other combinations of $!or $., direct assignment, declaring the attribute as rw (same error) yield different kind of errors. This is probably just a syntax issue, but I couldn't find the solution. Any help will be appreciated.
There are two things wrong in your example, the way I see it. First of all, if you want an attribute to be writeable, you will need to mark it is rw. Secondly, changing the value of an attribute is done by assignment, rather than by giving the new value as an argument.
So I think the code should be:
class my-class {
has $.dash-attribute is rw;
submethod BUILD(*%args) {
for %args.kv -> $k, $value {
self."$k"() = $value;
}
}
};
my $my-instance = my-class.new( dash-attribute => 'attribute value' );
dd $my-instance;
# my-class $my-instance = my-class.new(dash-attribute => "attribute value")
You could do it the same way the object system normally does it under the hood for you.
(not recommended)
class C {
has $.d;
submethod BUILD ( *%args ){
for self.^attributes {
my $short-name = .name.substr(2); # remove leading 「$!」
next unless %args{$short-name}:exists;
.set_value( self, %args{$short-name} )
}
}
}
say C.new(d => 42)
C.new(d => 42)

Adding user mode types for Perl 6 NativeCall structs

The Perl 6 docs list a bunch of types. Some of them, such as Str, have more complicated box/unbox behaviors.
Is it possible to define my own type, specifying my own routines for the box/unboxing? For a particular project, I have a bunch of types I'm reusing, and basically cut/pasting my accessor functions over and over.
For example, the C Struct uses a time_t, and I plug in accessor methods to go to/from a DateTime. Another example is a comma-separated list, I'd like to go to/from an Array and take care of the split/join automagically.
Is there a better way to do this?
Edit: Add Example:
constant time_t = uint64;
constant FooType_t = uint16;
enum FooType <A B C>;
class Foo is repr('CStruct') is rw
{
has uint32 $.id;
has Str $.name;
has FooType_t $.type;
has time_t $.time;
method name(Str $n?) {
$!name := $n with $n;
$!name;
}
method type(FooType $t?) {
$!type = $t with $t;
FooType($!type);
}
method time(DateTime $d?) {
$!time = .Instant.to-posix[0].Int with $d;
DateTime.new($!time)
}
}
my $f = Foo.new;
$f.id = 12;
$f.name('myname');
$f.type(B);
$f.time(DateTime.new('2000-01-01T12:34:56Z'));
say "$f.id() $f.name() $f.type() $f.time()";
# 12 myname B 2000-01-01T12:34:56Z
This works, I can set the various fields of the CStruct in Perl-ish ways (no lvalue, but I can pass them in as parameters).
Now I want to use time_t, FooType_t, etc. for many fields in a lot of structs and have them act the same way. Is there a better way other than to just copy those methods over and over?
Maybe macros could help here? I haven't mastered them yet.
You could write a trait that handles automatic attribute conversion on fetching or storing the attribute. The following should get you started:
multi sub trait_mod:<is>(Attribute:D $attr, :$autoconv!) {
use nqp;
my $name := $attr.name;
$attr.package.^add_method: $name.substr(2), do given $attr.type {
when .REPR eq 'P6int' {
method () is rw {
my $self := self;
Proxy.new:
FETCH => method () {
$autoconv.out(nqp::getattr_i($self, $self.WHAT, $name));
},
STORE => method ($_) {
nqp::bindattr_i($self, $self.WHAT, $name,
nqp::decont($autoconv.in($_)));
}
}
}
default {
die "FIXME: no idea how to handle {.^name}";
}
}
}
For example, take your use case of time_t:
constant time_t = uint64;
class CTimeConversion {
multi method in(Int $_ --> time_t) { $_ }
multi method in(DateTime $_ --> time_t) { .posix }
method out(time_t $_ --> DateTime) { DateTime.new($_) }
}
class CTimeSpan is repr<CStruct> {
has time_t $.start is autoconv(CTimeConversion);
has time_t $.end is autoconv(CTimeConversion);
}
Finally, some example code to show it works:
my $span = CTimeSpan.new;
say $span;
say $span.end;
$span.end = DateTime.now;
say $span;
say $span.end;

Singleton implementation on perl6

I looked at the following code on Rosetta code http://rosettacode.org/wiki/Singleton#Perl_6
which implements Singleton in Perl6
class Singleton {
has Int $.x is rw;
# We create a lexical variable in the class block that holds our single instance.
my Singleton $instance = Singleton.bless; # You can add initialization arguments here.
method new {!!!} # Singleton.new dies.
method instance { $instance; }
}
my $a=Singleton.bless(x => 1);
my $b=Singleton.bless(x=> 2);
say $a.x;
say $b.x;
#result
# 1
# 2
but it seems using this implementation i can create tow instances of the same class using bless see example above ,
is there an option to prevent the implemention to only one instance of the same class ?
Perl prides itself on providing many ways to do things leaving you to pick the one that suits your tastes and the application at hand. I say that to highlight that this is one simple but solid, hopefully self-explanatory way - I'm not putting it forward as "the best" because that depends on your circumstances.
#!/usr/bin/env perl6
class Scoreboard {
has Str $.home-team ;
has Str $.away-team ;
has Int $.home-score = 0 ;
has Int $.away-score = 0 ;
my Scoreboard $instance;
method new(*%named) {
return $instance //= self.bless(|%named) ;
}
multi method goal($team where * eq $!home-team, Int :$points = 6) {
$!home-score += $points
}
multi method goal($team where * eq $!away-team, Int :$points = 6) {
$!away-score += $points
}
method Str {
"At this vital stage of the game " ~
do given $!home-score <=> $!away-score {
when More {
"$!home-team are leading $!away-team, $!home-score points to $!away-score"
}
when Less {
"$!home-team are behind $!away-team, $!home-score points to $!away-score"
}
default {
"the scores are level! $!home-score apeice!"
}
}
}
}
my $home-team = "The Rabid Rabbits";
my $away-team = "The Turquoise Turtles"; # Go them turtles!
my $scoreboard = Scoreboard.new( :$home-team , :$away-team );
$scoreboard.goal($home-team, :4points) ;
say "$scoreboard";
$scoreboard.goal($away-team) ;
say "$scoreboard";
my $evil_second_scoreboard = Scoreboard.new;
$evil_second_scoreboard.goal($home-team, :2points) ;
say "$evil_second_scoreboard";
This produces;
At this vital stage of the game The Rabid Rabbits are leading The Turquoise Turtles, 4 points to 0
At this vital stage of the game The Rabid Rabbits are behind The Turquoise Turtles, 4 points to 6
At this vital stage of the game the scores are level! 6 apeice!
This overrides the default new (normally supplied by class Mu) and keep a reference to ourself (ie this object) in private class data. For private class data, we use a lexically scoped scalar declared with my. The // is the operator form of .defined. So, on the first run, we call bless which allocates the object and initialize the attributes, and then assign it to $instance. In subsequent calls to new, $instance is defined and is immediately returned.
If you want to prevent someone calling bless directly, you can add;
method bless(|) {
nextsame unless $instance;
fail "bless called on singleton Scoreboard"
}
which will ensure that only the first call will work.

How does one write custom accessor methods in Perl6?

How does one write custom accessor methods in Perl6?
If I have this class:
class Wizard {
has Int $.mana is rw;
}
I can do this:
my Wizard $gandalf .= new;
$gandalf.mana = 150;
Let's say I want to add a little check to a setter in my Perl6 class without giving up the $gandalf.mana = 150; notation (in other words, I don't want to write this: $gandalf.setMana(150);). The program should die, if it tries to set a negative mana. How do I do this? The Perl6 documentation just mentions it is possible to write custom accessors, but does not say how.
With more recent versions of Rakudo there is a subset named UInt that restricts it to positive values.
class Wizard {
has UInt $.mana is rw;
}
So that you're not stuck in a lurch if you need to something like this; here is how that is defined:
( you can leave off the my, but I wanted to show you the actual line from the Rakudo source )
my subset UInt of Int where * >= 0;
You could also do this:
class Wizard {
has Int $.mana is rw where * >= 0;
}
I would like to point out that the * >= 0 in the where constraint is just a short way to create a Callable.
You could have any of the following as a where constraint:
... where &subroutine # a subroutine that returns a true value for positive values
... where { $_ >= 0 }
... where -> $a { $a >= 0 }
... where { $^a >= 0 }
... where $_ >= 0 # statements also work ( 「$_」 is set to the value it's testing )
( If you wanted it to just not be zero you could also use ... where &prefix:<?> which is probably better spelled as ... where ?* or ... where * !== 0 )
If you feel like being annoying to people using your code you could also do this.
class Wizard {
has UInt $.mana is rw where Bool.pick; # accepts changes randomly
}
If you want to make sure the value "makes sense" when looking at all of the values in the class in aggregate, you will have to go to a lot more work.
( It may require a lot more knowledge of the implementation as well )
class Wizard {
has Int $.mana; # use . instead of ! for better `.perl` representation
# overwrite the method the attribute declaration added
method mana () is rw {
Proxy.new(
FETCH => -> $ { $!mana },
STORE => -> $, Int $new {
die 'invalid mana' unless $new >= 0; # placeholder for a better error
$!mana = $new
}
)
}
}
You can get the same accessor interface that saying $.mana provides by declaring a method is rw. Then you can wrap a proxy around the underlying attribute like so:
#!/usr/bin/env perl6
use v6;
use Test;
plan 2;
class Wizard {
has Int $!mana;
method mana() is rw {
return Proxy.new:
FETCH => sub ($) { return $!mana },
STORE => sub ($, $mana) {
die "It's over 9000!" if ($mana // 0) > 9000;
$!mana = $mana;
}
}
}
my Wizard $gandalf .= new;
$gandalf.mana = 150;
ok $gandalf.mana == 150, 'Updating mana works';
throws_like sub {
$gandalf.mana = 9001;
}, X::AdHoc, 'Too much mana is too much';
Proxy is basically a way to intercept read and write calls to storage and do something other than the default behavior. As their capitalization suggests, FETCH and STORE are called automatically by Perl to resolve expressions like $gandalf.mana = $gandalf.mana + 5.
There's a fuller discussion, including whether you should even attempt this, at PerlMonks. I would recommend against the above -- and public rw attributes in general. It's more a display of what it is possible to express in the language than a useful tool.