Conditional whenever

March 29, 2019 1 comment

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.

Advertisements
Categories: Uncategorized

I like Rakudo 100x

March 25, 2019 1 comment

One of my scripts stopped working without any change by my hands with a most peculiar error message:

Type check failed in binding to parameter '$s'; expected Str but got Int (42)
  in sub jpost at /home/bisect/.perl6/sources/674E3526955FCB738B7B736D9DBBD3BD5B162E5C (WWW) line 9
  in block <unit> at wrong-line-or-identifier.p6 line 3

Whereby line 9 looks like this:

@stations = | jpost "https://www.perl6.org", :limit(42);

Rakudo is missing the parameter $s and so am I. Because neither my script nor any routine in WWW does contain it. This is clearly a regression on a rather simple piece of code and in a popular module. Since I didn’t check that script for quite some time I can’t easily tell what Rakudo commit caused it.

In #perl6 we got bisectable6, a member of the ever growing army of useful bots. Yet it could not help me because it doesn’t come with the community modules installed. Testing against a few dozen Rakudo versions by hand was out of question. So I mustered the little bash-foo I have and wrote a few scripts to build Rakudos past. This resulted in #2779.

If you wish to go on a bug hunt for time travelers too, clone the scripts, install the modules your script needs and make sure it fails with an exit code greater 0. Then run ./build-head-to-tail.sh <nr-of-commits> to build as many Rakudos as you like. With ./run-head-to-tail <nr-of-commits> <your-script-name-here>. Up to the number of cores of the host tests are run in parallel. After a while you get a list of OK, FAILed and SKIPed commits. Any Rakudo commit that fails to build will be SKIPed.

Running as root may not work because the modules will be put in the wrong spot by zef. A single commit will take about 70MB of disk space with little hope for deduplication.

The brave folk who push Perl 5 ever forward have a whole CPAN worth of tests to check if anything breaks while they change the compiler. Our stretch of land is still quite small in comparison but I hope to have helped with testing it better.

Categories: Perl6

Threading nqp through a channel

February 3, 2019 1 comment

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.

Categories: Perl6, Uncategorized

nqp is faster then threads

February 2, 2019 1 comment

After heaving to much fun with a 20 year old filesystem and the inability of unix commands to hande odd filenames, I decided to replace find /somewhere -type f | xargs -P 10 -n 1 do-stuff with a Perl 6 script.

The first step is to travers a directory tree. I don’t really need to keep the a list of paths but for sure run stuff in parallel. Generating a supply in a thread seams to be a reasonable thing to do.

start my $s = supply {
for '/snapshots/home-2019-01-29/' {
emit .IO if (.IO.f & ! .IO.l);
.IO.dir()».&?BLOCK if (.IO.d & ! .IO.l);
CATCH { default { put BOLD .Str } }
}
}

{
my @files;
react whenever $s {
@files.push: $_;
}
  say +@files;
  say now - ENTER now;
}

Recursion is done with by calling the for block on the topic with .&?BLOCK. It’s very short and very slow. It takes 21.3s for 200891 files — find will do the same in 0.296s.

The OS wont be the bottleneck here, so maybe threading will help. I don’t want to overwhelm the OS with filesystem requests though. The buildin Telemetry module can tell us how many worker threads are sitting on their hands at any given time. If we use Promise to start workers by hand, we can decide to avoid threading when workers are still idle.

sub recurse(IO() $_){
my @ret;
@ret.push: .Str if (.IO.f & ! .IO.l);
  if (.IO.d & ! .IO.l) {
if Telemetry::Instrument::ThreadPool::Snap.new<gtq> > 4 {
@ret.append: do for .dir() { recurse($_) }
} else {
@ret.append: await do for .dir() {
Promise.start({ recurse($_) })
}
}
}
CATCH { default { put BOLD .Str } }
@ret.Slip
}
{
say +recurse('/snapshots/home-2019-01-29');
say now - ENTER now;
}

That takes 7.65s what is a big improvement but still miles from the performance of a 20 year old c implementation. Also find can that do the same and more on a single CPU core instead of producing a load of ~800%.

Poking around in Rakudos source, one can clearly see why. There are loads of IO::Path objects created and c-strings concatenated, just to unbox those c-strings and hand them over to some VM-opcodes. All I want are absolute paths I can call open with. We have to go deeper!

use nqp;

my @files;
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);
@files.push: $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);
}
say +@files; say now - ENTER now;

And this finishes in 2.58s with just 1 core and should play better in situations where not many filehandles are available. Still 9 times slower than find but workable. Wrapping it into a supply is a task for another day.

So for the time being — if you want fast you need nqp.

UPDATE: We need to check the currently waiting workers, not the number of spawned workers. Example changed to Snap.new<gtq>.

Categories: Perl6

A picky caller

January 23, 2019 1 comment

I have got myself a paradoxical harddrive by combining a fast ssd and a sizeable disk by setting up a a bcache on my linux box. Now I got a harddrive that is really fast with small files. There are a few stats bcache is providing via sysfs. To watch them one requires to read a few text files. A well suited task for slurp. I ended up with a bunch of pointy blocks that look like this:

-> $cache {
slurp("/sys/fs/bcache/$cache/cache_available_percent").chomp ~ '%'
}

I put them together with a name into an Array to be able to loop over them. As it turned out there are two groups of pointies. The one group needs the name of the bcache-block device which holds the actualy filesystem. The other group gets the UUID of the cache group. I need to group the output of the two groups so I get:

bcache0:
dirty data: 36.0k
ebc67019-9d50-4042-8080-b173e2ba802f:
hit ratio: 62% 66% 50% 0%
bypassed: 7.0G 2.4G 65.1M 9.1M
cache available: 94%

I could have split up the array but figured that I can check the signature of the pointy instead to select what is being output.

for bcache-devs() -> $dev {
  with $dev {
  say BOLD $dev, ':';
  for @stats -> $name, &f {
  next unless &f.signature.params».name eq '$dev';
  put "\t", $name, ': ', .&f
  }
  }
}

If the name of the positional doesn’t fit I just skip the output.

Next I tried to match the signature by adding subsets of Str to the signature of the pointes. Sadly matching a signature literal like so doesn’t work in this case.

subset Dev of Str;
say 'match' if &f.signature ~~ :(Dev $dev);

If I would define my one classes that would certainly work. It seems the sloppy matching of subsets is working as intended. A bit of a shame because subsets are so easy to set up. For my example just matching the parameter name is fine because it saves time when typing the pointies.

Nonetheless it’s really neat that the caller can has a say if it likes the signature of the callee in Perl 6.

Categories: Perl6

Iterating past the finish

January 11, 2019 Leave a comment

A while ago the question was raised how to augment Any. As it turns out the augmenting part is working but the newly added method is not propagated to children of buildin types. One can force the propagation by calling .compose on all type objects. Getting a list of all parents is done with .^mro and the check is done with .

augment class Cool { method HTML { HTML.new(self) } }
if Cool ∈ T.HOW.mro(T) { T.HOW.compose(T); }

I stepped on a Dragon

The tricky part is to get all predefined classes. Mostly because there is a lot of stuff in CORE:: that doesn’t even implement the interfaces to call methods. We can call .DEFINITE because that’s not a method. So we can weed out all predefined objects and are left with type objects and stuff that’s leaking from NQP into Perl 6-land. Those beasties don’t implement .mro so by guarding with try we can bild a list of all Perl 6 type objects. Those type objects contain IterationEnd. Hence we can’t trust for or anything else that is using iterators to loop over a list. There is also Slip in the list. We can help that by using binding everywhere.

my @a = CORE::.values;
my @types;
for 0..^@a.elems -> $i {
my \T := @a[$i];
try @types[$++] := T if not T.DEFINITE;
}

for 0..^@types.elems -> $i {
my \T := @types[$i];
try if Cool ∈ T.HOW.mro(T) {
T.HOW.compose(T);
}
}

And there we have it. All children of Cool have been re-.composed.

It’s no magic!

There are a few things I learned. Firstly much of the magic behind Perl 6 are just type checks. Anything that deals with iteration of lists or similar constructs is checking for Slip or IterationEnd and branching out to deal with their special nature.

And secondly there are a lot of interfaces leaking into spec-land that have no business there. I’m worried that might bite us later because any useful interface will be abused by programmers sooner or later. I would prefer the inner workings of Rakudo to be well hidden.

I found a way to deal with agumenting build in types so it can’t be long before the core devs fix that bug.

Categories: Perl6

Deconstructing Simple Grammars

May 10, 2018 1 comment

Last year I wrote an egg timer that was parsing command line arguments similar to GNU sleep. I was happy with the stringent form of the parser as follows.

my Seconds $to-wait = @timicles»\
    .split(/<number>/, :v)\
    .map(-> [$,Rat(Any) $count, Str(Any) $unit] --> Seconds { %unit-multipliers{$unit} * $count })\
    .sum;

It does a few simple things and does them one after another. A grammar with an action class would be overkill. I wasn’t happy with using splits ability to return the needle with the parts. It certainly does not improve readability.

After quite a few iterations (and stepping on a bug), I came up with a way to use Str.match instead. If I convert each Match-object into a Hash I can use deconstruction in a signature of a pointy block.

my Seconds $to-wait = @timicles»\
    .match(/<number> <suffix>+/)».hash\ # the +-quatifier is a workaround
    .map(-> % ( Rat(Any) :$number, Str(Any) :$suffix ) { %unit-multipliers{$suffix} * $number })\
    .sum;

Instead of using positionals I can use named arguments that correspond to the named regexes inside the match arguments.

Even in such a small pice of code things fall into place. Hyper-method-calls get rid of simple loops. The well crafted buildin types allow signature deconstruction to actually work without loads of temporary variables. It’s almost as certain language designers where aiming to make a most elegant language.

Categories: Perl6