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.
Related
My original plan was to use two once {next} blocks to skip the first two lines in a file (here emulating a as a multiline string):
for "A\nB\nC\n".lines() -> $line {
once {next}
once {next}
put $line;
}
But it only skipped one iteration instead of two, outputting the following:
B
C
Instead of what I expected:
C
Apparently a single once {next} somehow cancels all remaining once blocks in the same scope:
my $guard = 3;
loop {
last if $guard-- <= 0;
once { next };
once { put 'A: once ' };
once { put 'A: once again' };
put 'A: many ';
}
$guard = 3;
loop {
last if $guard-- <= 0;
once { put 'B: once ' };
once { next };
once { put 'B: once again' };
put 'B: many ';
}
$guard = 3;
loop {
last if $guard-- <= 0;
once { put 'C: once ' };
once { put 'C: once again' };
once { next };
put 'C: many ';
}
Outputting:
A: many
A: many
B: once
B: many
B: many
C: once
C: once again
C: many
C: many
(Example code here is a modified version of code at https://docs.raku.org/language/control#once).
Is this a bug or am I misunderstanding once {next} ?
The once construct semantics are associated with closure clones; since for is defined in terms of map, we can think of the block of the for loop being like a closure that is cloned once per loop, and that clone used for all iterations of the loop. The running of once blocks is done only on the first invocation of that closure clone. That is to say, it's a property at the level of the closure, not one of the once block itself.
The very same semantics apply to state variable initializers, which are defined in the same way (that is, they have once semantics). Therefore, this this also exhibits the same behavior:
for "A\nB\nC\n".lines() -> $line {
state $throwaway-a = next;
state $throwaway-b = next; # this `next` never runs
put $line;
}
Alternative semantics could have been chosen, however a per-once (and so per-state variable) indicator would imply an extra piece of state is needed for each of them.
So far as the original problem goes, a clearer solution would be:
for "A\nB\nC\n".lines().skip(2) -> $line {
put $line;
}
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;
Take this sample code:
#!/usr/bin/env perl6
use v6.c;
ROLL:
for 1..10 -> $r {
given (1..6).roll {
when 6 {
say "Roll $r: you win!";
last ROLL;
}
default {
say "Roll $r: sorry...";
}
}
LAST {
say "You either won or lost - this runs either way";
}
}
I'd like to be able to distinguish falling out of the loop from explicitly saying last.
Ideally, there'd be a phaser for this, but as far as I can find, there is only LAST which runs in either case.
Is there an elegant way to do this? (Elegant, so without adding a $won variable.)
We're dealing with Perl, so There's More Than One Way To Do It; one of them is using the topic variable $_ to keep the value so we can easily match against it repeatedly:
constant N = 5;
for flat (1..6).roll xx * Z 1..N -> $_, $n {
print "roll $n: $_ ";
when 6 {
put "(won)";
last;
}
default {
put "(lost)";
}
LAST {
print "result: ";
when 6 { put "winner :)" }
default { put "loser :(" }
}
}
Here's another way to do it. Elegant? I think reasonably so. I wish there were a separate phaser for this, though.
#!/usr/bin/env perl6
use v6.c;
constant MAX_ROLLS = 10;
ROLL:
for 1..MAX_ROLLS+1 -> $r {
last ROLL if $r > MAX_ROLLS;
given (1..6).roll {
when 6 {
say "Roll $r: you win!";
last ROLL;
}
default {
say "Roll $r: sorry...";
}
}
LAST {
say "You lost, better luck next time!" if $r > MAX_ROLLS;
}
}
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?
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.