Archive
Most trusting
I was looking for a neat way to specify units when working with numbers. When doing dimensional analysis, many physicists like to put units into square brackets to create an additional namespace. We can do the same.
use v6.d;
class Unit { ... }
class SiInt is Int {
trusts GLOBAL;
trusts Unit;
has Unit $!unit;
method !unit { return-rw $!unit }
method new(CORE::Int $new) { nextsame }
method Str { self.Int::Str ~ $!unit.suffix }
method ACCEPTS(Unit:U $u) { $!unit === $u }
}
class Unit {
our $.suffix = '';
our $.long-name = "unit-less";
method ACCEPTS(SiInt $si) { $si!SiInt::unit === self }
}
class m is Unit { our $.suffix = 'm'; our $.long-name = 'Meter'; }
multi sub postcircumfix:<[ ]>(SiInt $obj, Unit:U $unit) {
$obj!SiInt::unit === Unit ?? ($obj!SiInt::unit = $unit)
!! fail(‘Sorry, units can only be set, not changed.’);
$obj
}
multi sub postcircumfix:<[ ]>(Int $value, Unit:U $unit) { SiInt.new($value)[$unit] }
constant Int = SiInt; # intentional shadowing of CORE::Int
my $i = 42[m];
put [$i, $i.^name]; # 42m SiInt
my Int() $a = 1;
put [$a, $a.^name]; # 1 SiInt
class s is Unit { our $.suffix = 's'; our $.long-name = 'Seconds'; }
multi sub infix:<+>(SiInt $l, SiInt $r) {
$l!SiInt::unit === Unit ?? callsame()[$r!SiInt::unit]
!! $r!SiInt::unit === Unit ?? callsame()[$l!SiInt::unit]
!! $l!SiInt::unit === $r!SiInt::unit ?? nextsame()
!! fail(„Unit mismatch between $l and $r“)
}
my $s = 60[s];
say $i + $a; # 43m
say $s + $i; # Unit mismatch between 60s and 42m
The idea is to have a numerical type that is by default unit-less. A unit can be added (but not changed) with square bracket postcircumfix. Since I add type-objects for each unit, I don’t have to mess around with strings and can multi-dispatch if needed. Since I want direct access to the unit, I tell the class to trust the package the operators are defined in. (This could be a module, of course.) What happens to be an ENODOC.
I have to use a forward declaration to get ACCEPTS
to get hold of $!unit
. Subsequently, multi-dispatch works just fine.
multi sub fancy(Int $value where m) { #`[fancy calculation goes here] }
multi sub fancy(Int) { fail ‘Can only be fancy with Unit "m".’ }
fancy($i);
Since SiInt
is just an Int
all built-ins will work, so long the unit is restored after using them. Being able to trust operators allows them to access the entire class, without having to cheat with use nqp;
.
Because Raku treats types as values, I can calculate a compound unit.
class Meters-per-Second is Unit { our $.suffix = 'm/s'; our $.long-name = 'Meters per Second'; }
multi sub infix:</>(m, s) { Meters-per-Second }
sub speed($d where m, $t where s) { ($d / $t).Int.[m/s] }
my Int $fast = speed(500[m], 1[s]);
say $fast; # 500m/s
I’m quite pleased with being able to extend the type-system so easily without having to invent a complete new DSL. This aids composability greatly.
Plucking strings
This is a correction and follow-up of my previous post. The ever helpful vrurg provided a simplification to my transformative role. I added some evil to it, mostly for nicer looking introspection.
role Trans[::From, ::To, &c] {
has To $.value;
method COERCE(From:D $old) {
self.new(:value($old.&c))
}
unless ::?ROLE.^declares_method(my $mname = To.^name) {
::?ROLE.^add_method: $mname, ('my method ' ~ $mname ~ '(--> To) { $.value }').EVAL;
}
}
By checking if the role contains a method already, I don’t need to fool around with the method table any more. I use .EVAL
to compose the method name properly. Rakudo doesn’t care, but a human looking at the method name does not need to be confused. Please note the absence of use MONKEY;
. The method form of EVAL
doesn’t require it. It is safe to assume code not to be safe.
Task 2 can be written as a naive algorithm. Keep the stickers that contain characters that are also in the target word. Check if all letters in the target word are in the kept stickers. If so, show them or complain.
Again, I need a way to turn words into Set
s. I shall do so by invoking the coercion-protocol with a new
-method.
class Plucked {
has $.str;
has @.chars;
method new(Str:D $s) { callwith :str($s), :chars($s.comb) }
method gist { $!str ~ ' ' ~ @!chars.pairs».&{ .key ~ ' ' ~ .value } }
method Str { $.str }
method Set { @.chars.Set }
method AT-POS($pos) { @.chars.AT-POS($pos) }
method AT-KEY($key) { @.chars.grep( * eq $key ) }
}
constant PC = Plucked(Str:D);
for [
('perl','raku','python'), 'peon';
('love','hate','angry'), 'goat';
('come','nation','delta'), 'accommodation';
('come','country','delta'), 'accommodation'
] -> [ @stickers, PC $word ] {
my @keep;
for @stickers -> PC $sticker {
@keep.push($sticker) if $word ∩ $sticker;
}
if ([∪] @keep) ⊇ $word {
put „"$word" can be made with "$@keep"“;
} else {
my $missing = $word ∖ ([∪] @keep);
put „"$word" can not be made, "$missing" is missing“;
}
}
The helper class Plucked
knows how to dissect Str
s and turn them into Set
s and Str
s. Since laziness is a virtue, I reduce the amount of typing by storing the coercion-type in a constant. Then I write the naive algorithm down.
I didn’t know that I can store coercion-types the same way as other type-objects in a constant. It just DWIMed and that pleases me greatly.
Reducing sets
This week´s PWC asks us for hexadecimal words and distinctly different directories.
sub term:<pwc-166-1> {
sub less-substitutions-then ($_, $n) {
.subst(/<-[olist]>/, :g, '').chars < $n
}
'/usr/share/dict/words'.IO.words.race\
.grep({.chars ≤ 8 && .&less-substitutions-then(4)})\
.map(*.trans(<o l i s t> => <0 1 1 5 7>))\
.grep(/^ <[0..9 a..f A..F]>+ $/)\
.sort(-*.chars)\
.say;
};
Once again, we write the algorithm down. Get the words, drop anything longer then 8 chars or what would need more then 4 substitutions. Then do the substitutions and grep anything that looks like a hexadecimal numeral. Sort for good measure and output the first 100 elements.
The second task provides us with a little challenge. We need to mock listing directories and working with them. Since dir
returns a sequence of IO::Path
I can create those by hand and mixin a role that mimics some filesystem operations. I can overload dir
to provide a drop-in replacement.
sub term:<pwc-166-2> {
sub basename(IO::Path $_) { .basename ~ (.d ?? '/' !! '') }
sub pad(Str $_, $width, $padding = ' ') { .Str ~ $padding x ($width - .chars) }
sub dir(Str $name) {
sub mock-file(*@names) { @names.map({ IO::Path.new($_) but role :: { method f ( --> True ) {}; method e ( --> True ) {} } } ) }
sub mock-dir(*@names) { @names.map({ IO::Path.new($_) but role :: { method d ( --> True ) {}; method e ( --> True) {} } }) }
constant %dirs = dir_a => flat(mock-file(<Arial.ttf Comic_Sans.ttf Georgia.ttf Helvetica.ttf Impact.otf Verdana.ttf>), mock-dir(<Old_Fonts>)),
dir_b => mock-file(<Arial.ttf Comic_Sans.ttf Courier_New.ttf Helvetica.ttf Impact.otf Tahoma.ttf Verdana.ttf>),
dir_c => mock-file(<Arial.ttf Courier_New.ttf Helvetica.ttf Impact.otf Monaco.ttf Verdana.ttf>);
%dirs{$name}
}
sub dir-diff(+@dirs) {
my @content = @dirs».&dir».&basename;
my @relevant = (([∪] @content) ∖ [∩] @content).keys.sort;
my @columns = @content.map(-> @col { @relevant.map({ $_ ∈ @col ?? $_ !! '' }) });
my $col-width = [max] @columns[*;*]».chars;
put @dirs».&pad($col-width).join(' | ');
put (''.&pad($col-width, '-') xx 3).join('-+-');
.put for ([Z] @columns)».&pad($col-width)».join(' | ');
}
dir-diff(<dir_a dir_b dir_c>);
};
I’m asked to add a /
to directories and do so with a custom basename
. The rest is liberal application of set theory. Only names that don’t show up in all directories are relevant. Columns are created by matching the content of each directory against the relevant names. The width of columns is the longest string. The header is put on screen. To output the columns line by line, x and y are flipped with [Z]
.
After careful study of the solutions written in other languages, I believe it is fair to call Raku an eco-friendly language. Our keyboards are going to last at least twice a long.
Typed filters
The Discord Raku bot is now also an IRC -> Discord bridge. To handle the streams of messages I use a react
-block with a few whenever
s. I would like to handle filtering of debug output from API::Discord in there as well, without disrupting something simple like printing to the terminal.
In my last post I showed how I can control the behaviour of a module with the use statement. The next step is to divert writes to $*ERR
to a Supply
.
my $active = False;
sub debug-print(|c) {
$*ERR.print: |c if $active;
}
sub debug-print-supply(Supply $in? --> Supply:D) {
my $result = $in // Supplier::Preserving.new;
&debug-print.wrap(-> |c {
$result.emit: |c
});
$result.Supply
}
multi sub EXPORT('FROM-MODULE') {
%(
'&debug-print' => &debug-print,
)
}
multi sub EXPORT() {
$active = True;
%(
'&debug-print' => &debug-print-supply,
)
}
As long as the user of the module doesn’t call debug-print
, we have the simple case of writing to $*ERR
. When debug-print
is called, we divert the stream into a Supply
. If no Supply
is supplied, we create one. To be able to filter output a role is created in API::Discord::Debug
.
role LogEventType is export {}
This role is indeed empty and so are the roles that are created to provide filters.
unit module Testmodule;
use API::Discord::Debug <FROM-MODULE>;
role HEARTBEAT does LogEventType is export {}
role PING does HEARTBEAT does LogEventType is export {}
start loop {
sleep ¼;
debug-print("ping" but PING);
debug-print("pong" but PONG) unless 10.rand < 2;
}
So we create a Str
and mixin a role, what is a type object we can check against.
use API::Discord::Debug;
use Testmodule;
react {
my $pings = 0;
whenever debug-say().merge(debug-print()) {
when PING { $pings++; }
when PONG { $pings--; }
default { .note }
}
whenever Supply.interval(5) {
say „$pings heartbeats are lost“ if $pings > 1;
}
}
Mixing in an empty role wont upset any unsuspecting bystander and type checks compose well. Here I use them with when
/default
, a multi dispatch would work as well. Introspection can be done with .WHAT.say
.
On CPAN we can find many “complete” modules that kill a specific problem once and for all. For many of those, there tends to be another module suffixed with ::Simple
. Simple stuff should be simple because we can’t buy any more days in this life. We also don’t take anything with us. I hope I can leave something simple behind instead.
Late early bound
My last post got at least two people thinking. I made the suggestion to add a sub called pretty-print
to make the resulting text/html
human friendly. Since this is a nice name, making it a multi seams a polite move.
multi sub pretty-print(html::("NON-QUOTE") $html) { ... }
Since html
is a singleton of an anonymous class, we can’t easily refer to the role NON-QUOTE
within. We use a runtime lookup to get hold of the type at compile time. Said compile time is actually quite late. It happens at the same time constant
s are evaluated. Hence, html
‘s guts can be queried, because that constant expression is further up in the file.
I did not know that type constraints are turned into type objects that late and found it difficult to explain. We may have to invent time travel to learn the time traveller language to be able to explain the order of operations of Rakudo.
Awaiting a bugfix
When using Proc::Async
we need to await
while waiting for a fix for R#3817. While adding many tests to Shell::Piping I got a flapper on Travis. After my last misadvanture while testing async code I learned to use stress -c 30
to make sure that OS threads are congested. And sure enough, I got the same tests to fail then on Travis. A workaround is to await
after reading form Proc::Async.stdout
. In my code that looks like the following.
for $.proc-out-stdout.lines {
my $value := &.code.($_);
my $processed = $value === Nil ?? ‚‘ !! $value ~ "\n";
await $.proc-in.write: $processed.encode with $.proc-in;
# ^^^^^ WORKAROUND for R#3817
}
I then had to add a piece of odd code at another place to have something to await
on.
method write($blob) { my $p = Promise.new; $p.keep; a.push: $blob.decode.chomp; $p }
The Promise
is really just there so we can nudge Rakudo to have a good look at its threads. If you are using Proc::Async
in your code please check for .write
and test it on a system with more work then cores. You wont get an error with this bug. It will just silently drop values that are send via .write
to another process or fetched via .stdout.lines
. Good hunting!
Conditional whenever
I wrote a script to filter iostat because the latter either displays too much or too little. It also doesn’t know about bcache. I wanted to have the script react the same way to pressing q then top
, atop
or iotop
. But it should only watch the keyboard and quit when $*OUT
is a terminal. First we need to read the keyboard.
whenever key-pressed(:!echo) {
when 'q' | 'Q' { done }
}
Now we got a few options to add a check for an attached terminal
if $*OUT.t {
whenever key-pressed(:!echo) {
when 'q' | 'Q' { done }
}
}
$*OUT.t && do whenever key-pressed(:!echo) {
when 'q' | 'Q' { done }
}
do whenever key-pressed(:!echo) {
when 'q' | 'Q' { done }
} if $*OUT.t
The last one kind of lines up with other whenever
blocks but the condition gets harder to read. At first I thought it wont be possible to use ?? !!
because whenever
always wants to run .tap
on the parameter. But then I remembered that we use 0x90 to tell a CPU to do nothing. If we get a Supply
that does nothing we can opt out of doing something.
constant NOP = Supplier.new;
whenever $*OUT.t ?? key-pressed(:!echo) !! NOP {
when 'q' | 'Q' { done }
}
Now it neatly lines up with other whenever
blocks.
As a member of the Perl family Perl 6 has more then one way to do it. Most of them look a big odd though.
Threading nqp through a channel
Given that nqp is faster then plain Perl 6 and threads combining the two should give us some decent speed. Using a Supply
as promised in the last post wouldn’t really help. The emit
will block until the internal queue of the Supply
is cleared. If we want to process files recursively the filesystem might stall just after the recursing thread is unblocked. If we are putting pressure on the filesystem in the consumer, we are better of with a Channel
that is swiftly filled with file paths.
Let’s start with a simulated consumer that will stall every now end then and takes the Channel
in $c
.
my @files;
react {
whenever $c -> $path {
@files.push: $path;
sleep 1 if rand < 0.00001;
}
}
If we would pump out paths as quickly as possible we could fill quite a bit of RAM and put a lot of pressure on the CPU caches. After some trial and error I found that sleeping befor the .send
on the Channel
helps when there are more then 64 worker threads waiting to be put onto machine threads. That information is accessible via Telemetry::Instrument::ThreadPool::Snap.new<gtq>
.
my $c = Channel.new;
start {
my @dirs = '/snapshots/home-2019-01-29';while @dirs.shift -> str $dir {
my Mu $dirh := nqp::opendir(nqp::unbox_s($dir));
while my str $name = nqp::nextfiledir($dirh) {
next if $name eq '.' | '..';
my str $abs-path = nqp::concat( nqp::concat($dir, '/'), $name);
next if nqp::fileislink($abs-path);
if Telemetry::Instrument::ThreadPool::Snap.new<gtq> > 64 {
say Telemetry::Instrument::ThreadPool::Snap.new<gtq>;
say 'sleeping';
sleep 0.1;
}
$c.send($abs-path) if nqp::stat($abs-path, nqp::const::STAT_ISREG);
@dirs.push: $abs-path if nqp::stat($abs-path, nqp::const::STAT_ISDIR);
}
CATCH { default { put BOLD .Str, ' ⟨', $dir, '⟩' } }
nqp::closedir($dirh); }
$c.close;
}
Sleeping for 0.1s before sending the next value is a bit naive. It would be better to watch the number of waiting workers and only continue when it has dropped below 64. But that is a task for a differnt module. We don’t really have a middle ground in Perl 6 between Supply with it’s blocking nature and the value pumping Channel. So such a module might be actually quite useful.
But that will have to wait. I seam to have stepped on a bug in IO::Handle.read while working with large binary files. We got tons of tests on roast that deal with small data. Working with large data isn’t well tested and I wonder what monsters are lurking there.
Issue All The Things
While on her epic quest to clean up the meta part of the ecosystem samvc send me a few pull requests. That raised the question which of my modules have open issues. Github is quite eager to list you many things but lacks the ability to show issues for a group of repos. Once again things fell into place.
Some time ago I made a meta module to save a few clicks when testing modules once a week. What means I have a list of modules I care about already.
perl6 -e 'use META6; use META6::bin :TERM :HELPER;\\ for META6.new(file => "$*HOME/projects/perl6/gfldex-meta-zef-test/META6.json").<depends> -> $name {\\ say BOLD $name;\\ }'
META6::bin
didn’t know about Github issues, what was easily solved, including retries on timeouts of the github api. Now I can feed the module names into &MAIN
and get a list of issues.
perl6 -e 'use META6; use META6::bin :TERM :HELPER;\\ for META6.new(file => "$*HOME/projects/perl6/gfldex-meta-zef-test/META6.json").<depends> -> $name {\\ say BOLD $name;\\ try META6::bin::MAIN(:issues, :module($name), :one-line, :url);\\ }'
I switfly went to merge the pull requests.
Test::META [open] Add License checks and use new META license spec [10d] ⟨https://github.com/jonathanstowe/Test-META/pull/21⟩ [open] warn on source [35d] ⟨https://github.com/jonathanstowe/Test-META/issues/20⟩ [open] warn on empty description [37d] ⟨https://github.com/jonathanstowe/Test-META/issues/19⟩ [open] check if source-url is accessible [37d] ⟨https://github.com/jonathanstowe/Test-META/issues/18⟩ [open] Check `perl` version [135d] ⟨https://github.com/jonathanstowe/Test-META/issues/14⟩ [open] Report missing modules? [1y] ⟨https://github.com/jonathanstowe/Test-META/issues/8⟩ [open] Add :strict-versions switch [1y] ⟨https://github.com/jonathanstowe/Test-META/issues/7⟩ [open] Test harder that "provides" is sane [1y] ⟨https://github.com/jonathanstowe/Test-META/issues/6⟩ Typesafe::XHTML::Writer Rakudo::Slippy::Semilist Slippy::Semilist Github timed out, trying again 1/3. Github timed out, trying again 2/3. Github timed out, giving up. Operator::defined-alternation Concurrent::Channelify [open] Use SPDX identifier in license field of META6.json [3d] ⟨https://github.com/gfldex/perl6-concurrent-channelify/pull/1⟩ Concurrent::File::Find [open] Use SPDX identifier in license field of META6.json [3d] ⟨https://github.com/gfldex/perl6-concurrent-file-find/pull/1⟩ XHTML::Writer Github timed out, trying again 1/3. Typesafe::HTML Git::Config Proc::Async::Timeout Github timed out, trying again 1/3. [open] Use SPDX identifier in license field of META6.json [9d] ⟨https://github.com/gfldex/perl6-proc-async-timeout/pull/1⟩
To check the issues of any project that got a META6.json
run meta6 --issues
. To check if there are issues for a given module in the ecosystem use meta6 --issues --module=Your::Module::Name
UPDATE:
As requested by timotimo, meta6 --issues --one-line --url --deps
will list all issues of the repo and all issues of the dependencies listed in META6.json
.
You can call me Whatever you like
The docs spend many words to explain in great detail what a Whatever
is and how to use it from the caller perspective. There are quite a few ways to support Whatever
as a callee as I shall explain.
Whatever
can be used to express “all of the things”. In that case we ask for the type object that is Whatever
.
sub gimmi(Whatever) {};
gimmi(*);
Any expression that contains a Whatever
* will be turned into a thunk. The latter happens to be a block without a local scope (kind of, it can be turned into a block when captured). We can ask specifically for a WhateverCode
to accept Whatever
-expressions.
sub compute-all-the-things(WhateverCode $c) { $c(42) }
say compute-all-the-things(*-1);
say (try say compute-all-the-things({$_ - 1})) // 'failed';
# OUTPUT: «41failed»
We could also ask for a Block
or a Method
as both come preloaded with one parameter. If we need a WhateverCode
with more then one argument we have to be precise because the compiler can’t match a Callable sub-signature with a WhateverCode.
sub picky(WhateverCode $c where .arity == 2 || fail("two stars in that expession please") ) {
$c.(1, 2)
}
say picky(*-*);
# OUTPUT: «-1»
say (try picky(*-1)) // $!;
# OUTPUT: «two stars in that expession please in sub picky at …»
The same works with a Callable
constraint, leaving the programmer more freedom what to supply.
sub picky(&c where .arity == 2) { c(1, 2) }
There are quite a few things a WhateverCode
can’t do.
sub faily(WhateverCode $c) { $c.(1) }
say (try faily( return * )) // $!.^name;
# OUTPUT: «X::ControlFlow::Return»
The compiler can take advantage of that and provide compile time errors or get things done a little bit qicker. So trading the flexibility of Callable
for a stricter WhateverCode
constraint may make sense.
You must be logged in to post a comment.