Adding user mode types for Perl 6 NativeCall structs - raku

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;

Related

How to print an object, type in nqp

How to print an object in NQP ? (For debugging purposes)
It is easy in Raku:
say that is calling gist in its short loop code
dd The tiny Data Dumper as shown in this post
class Toto { has $.member = 42; }
class Titi { has $.member = 41; has $.toto = Toto.new }
my $ti = Titi.new;
say $ti;
# Titi.new(member => 41, toto => Toto.new(member => 42))
dd $ti;
# Titi $ti = Titi.new(member => 41, toto => Toto.new(member => 42))
It seems more complicated in NQP
class Toto { has $!member; sub create() {$!member := 42}};
class Titi { has $!member; has $!toto; sub create() {$!member := 41; $!toto := Toto.new; $!toto.create; }}
my $ti := Titi.new;
say($ti);
Cannot stringify this object of type P6opaque (Titi)
Of course, no .gist method, the code calls nqp::encode which finally expects a string.
Reducing the problem to an MRE:
class foo {}
say(foo.new); # Cannot stringify ...
Simplifying the solution:
class foo { method Str () { 'foo' } }
say(foo.new); # foo
In summary, add a Str method.
This sounds simple but there's a whole lot of behind-the-scenes stuff to consider/explain.
nqp vs raku
The above solution is the same technique raku uses; when a value is expected by a routine/operation to be a string, but isn't, the language behavior is to attempt to coerce to a string. Specifically, see if there's a Str method that can be called on the value, and if so, call it.
In this case NQP's NQPMu, which is way more barebones than raku's Mu, doesn't provide any default Str method. So a solution is to manually add one.
More generally, NQP is a pretty hostile language unless you know raku fairly well and have gone thru A course on Rakudo and NQP internals.
And once you're up to speed on the material in that course, I recommend you consider the IRC channels #raku-dev and/or #moarvm as your first port of call rather than SO (unless your goal is specifically to increase SO coverage of nqp/moarvm).
Debugging the compiler code
As you will have seen, the NQP code you linked calls .say on a filehandle.
That then calls this method.
That method's body is $str ~ "\n". That code will attempt to coerce $str to a string (just as it would in raku). That's what'll be generating the "Cannot stringify" error.
A search for "Cannot stringify" in the NQP repo only matched some Java code. And I bet you're not running Rakudo on the JVM. That means the error message must be coming from MoarVM.
The same search in the MoarVM repo yields this line in coerce.c in MoarVM.
Looking backwards in the routine containing that line we see this bit:
/* Check if there is a Str method. */
MVMROOT(tc, obj, {
strmeth = MVM_6model_find_method_cache_only(tc, obj,
tc->instance->str_consts.Str);
});
This shows the backend, written in C, looking for and invoking a "method" called Str. (It's relying on an internal API (6model) that all three layers of the compiler (raku, nqp, and backends) adhere to.)
Customizing the Str method
You'll need to customize the Str method as appropriate. For example, to print the class's name if it's a type object, and the value of its $!bar attribute otherwise:
class foo {
has $!bar;
method Str () { self ?? nqp::coerce_is($!bar) !! self.HOW.name(self) }
}
say(foo.new(bar=>42)); # 42
Despite the method name, the nqp say routine is not expecting a raku Str but rather an nqp native string (which ends up being a MoarVM native string on the MoarVM backend). Hence the need for nqp::coerce_is (which I found by browsing the nqp ops doc).
self.HOW.name(self) is another example of the way nqp just doesn't have the niceties that raku has. You could write the same code in raku but the idiomatic way to write it in raku is self.^name.
Currently, what I have is a list and hash discriminator. It does not work on object.
sub print_something ($value, :$indent = 0, :$no-indent=0) {
if nqp::ishash($value) {
print_hash($value, :$indent);
} elsif nqp::islist($value) {
print_array($value, :$indent);
} else {
if $no-indent {
say($value);
} else {
say_indent($indent, $value);
}
}
}
Where
sub print_indent ($int, $string) {
my $res := '';
my $i := 0;
while $i < $int {
$res := $res ~ ' ';
$i := $i + 1;
}
$res := $res ~ $string;
print($res);
}
sub print_array (#array, :$indent = 0) {
my $iter := nqp::iterator(#array);
say_indent($indent, '[');
while $iter {
print_value(nqp::shift($iter), :indent($indent+1));
}
say_indent($indent, ']');
}
sub print_hash (%hash, :$indent = 0) {
my $iter := nqp::iterator(%hash);
say_indent($indent, '{');
while $iter {
my $pair := nqp::shift($iter);
my $key := nqp::iterkey_s($pair);
my $value := nqp::iterval($pair);
print_indent($indent + 1, $key ~ ' => ');
print_value($value, :indent($indent+1), :no-indent(1));
}
say_indent($indent, '}');
}

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)

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.

Convert Namespace to a single proc

I have a set of procs and a namespace as you can see below:
namespace eval ::_API {
if {[info exists ::_API::API_ids]} {
catch {API erase -ids [array names ::_API::API_ids]}
}
catch {unset API_ids}
array set API_ids ""
}
proc ::_API::erase { } {
foreach id [array names ::_API::API_ids] {
if {::_API::API_ids($id) == 0} {
continue
}
if {[catch {API -id $id -redraw 0}] != 0} {
set ::_API::API_ids($id) 0
}
}
Redraw ;# I'm not concerned about this part
# and I'm fairly certain it can be ignored
}
proc erase { } {
::_API ::erase
}
::_API::API_ids is an array that contains points (e.g. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15). What the script does is erase points in a table.
I want to convert the namespace ::_API into a proc so that I can use a GUI button to call the proc. It is currently directly after some other scripts (which map the points in the table) and I want to erase them only when required; i.e. when the button will be pressed.
I already tried running ::_API::erase directly but it is not working:
proc ::_API::erase { } {
foreach id [array names ::_API::API_ids] {
if {::_API::API_ids($id) == 0} {
continue
}
if {[catch {API -id $id -redraw 0}] != 0} {
set ::_API::API_ids($id) 0
}
}
Redraw
}
I think that there might be something I'm missing about the namespace. I tried reading the documentation but I don't quite understand really how they work.
The first thing that you really must do is use variable to declare the variable. For some fairly ugly reasons, failing to do that can cause “fun” with variable resolution to make things happen in ways you don't expect:
namespace eval ::_API {
variable API_ids; ##### <<<<<<< THIS <<<<<<< #####
if {[info exists ::_API::API_ids]} {
catch {API erase -ids [array names ::_API::API_ids]}
}
catch {unset API_ids}
array set API_ids ""
}
Secondly, you probably ought to actually think in terms of using real OO for this rather than trying to fake it. For example, with TclOO you'd be writing something like:
oo::class create APIClass {
variable ids
constructor {} {
array set ids {}
}
method erase {} {
foreach id [array names ids] {
if {$ids($id) == 0} continue
if {[catch {
API -id $id -redraw 0
}]} {
set ids($id) 0
}
}
Redraw
}
# Allow something to reference the ids variable from the outside world
method reference {} {
return [my varname ids]
}
}
APIClass create _API
# [_API erase] will call the erase method on the _API object
This simplifies things quite a bit, and in fact you can think in terms of coupling the drawing and the data management quite a lot closer than I've done above; it's just indicative of what you can do. (I find that it makes stuff a lot simpler when I use objects, as they've got a much stronger sense of lifecycle about them than ordinary namespaces.)
What you mean is you want to convert the namespace initialization code into a procedure. The following example should achieve that.
namespace eval ::_API {
}
proc ::_API::initialize {} {
variable API_ids
if {[info exists API_ids]} {
catch {API erase -ids [array names API_ids]}
unset API_ids
}
array set API_ids ""
}
... more definitions ...
::_API::initialize
We start by declaring the namespace. Then replicate the original code in a procedure. As there is no point unsetting a non-existent variable, we move unset into the block that only runs if the variable exists.
At the end of the namespace definitions, initialize the namespace by calling its initialization function.