A hard simple thing

Bugs that originate in reliable subsystems are hard to spot because we don’t expect them to fail. A filesystem path usually just works. This has bit me a few times before. While renovating my backup script I found that I provide quite a few status and debug messages that basically call .gist on an IO::Path instance. Since one might want to use a hypothetical path, Raku can’t complain on non-existing paths until they are used. Further, it can be quite useful to know that a path is a symlink. Bash and friends help here with colour coding. Since I have plenty of say-calls, it would be nice to change them all in one go. So wraping it is!

my &RED = sub (*@s) { "\e[31m{@s.join('')}\e[0m" }
my &GREEN = sub (*@s) { "\e[32m{@s.join('')}\e[0m" }
my &CYAN = sub (*@s) { "\e[36m{@s.join('')}\e[0m" }

my &io-path-gist = IO::Path.^can('gist')[0];

&io-path-gist = &io-path-gist.wrap(my method gist (Mu: --> Str ) {
    nextsame unless self ~~ IO::Path;

    my $s = self.Str;
    $s = self.e && self.r ?? $s !! RED($s);
    $s = self.l ?? CYAN($s) !! $s;
    $s = self.x && !self.d ?? GREEN($s) !! $s;
    $s = self.d ?? $s ~ ‚/‘ !! $s;

    "⟨$s⟩"
}).&{ -> { .restore } };

We get a handle on the proto of .gist because .wrap never operates on multi candidates (this might change, see here). I’m using a method with Mu as the invocant for clarity. A sub with a single positional would do as well. Since the wrapper is called by the proto, we need to redispatch on anything but IO::Path. The returned WrapHandle isn’t really useful and neither is the unwrapped handle to .gist. By storing a closure we can restore the default by calling io-path-gist(). The rest is some colouring and adding a / to mark directories. I like to put a path into fancy quotes to make it easy to spot leading and trailing white spaces.

Declaring class-methods and calling them is a hard thing that is easy because the implementer was sufficiently tormented. Getting hold of methods at runtime is a simple thing that is hard. Huffmanizing applies. We call methods much more often then wrapping them. Sometimes it is good to break a design principle.

Internal indirection

With writing more and more shell scripts in Raku, I realised that I call a MAIN by a MAIN in a very indirect manner. I wondered if I can find a way to reduce the indirection to get rid of the extra process and at least some of the overhead of Proc::Async. First we need a script to call.

#! /usr/bin/env raku

constant \frame = gather while my $frame = callframe($++) {
    take $frame
}

sub MAIN {
    say frame[0];

    .note for lines;

    exit 42;

    say 'alive';
}

This script prints its caller. Then reads blocking indirectly on $*IN via lines. It would print alive if the process would make it past the exit. Please note, that MAIN is the last statement in this compunit. That allows us to slurp the script and EVAL it.

my &main := $path.IO.slurp.&EVAL;

And that’s it! We can call a MAIN from another script. There are a few considerations though. We can pipe data to from one script to another because they share $*IN and $*OUT. Also, STDERR might get confusing. The semantics of exit may be wrong. It is likely that we want to keep the outer script running. Capturing the return-value of the inner script is easy, the exitcode is not.

Since we are calling functions lexicals can help with solving most of those problems. In Raku we can’t easily trap c-land exit. But we can prevent it from being called.

my &*EXIT = sub ($exitcode) {
    CapturedExitcode.new(:$exitcode).throw;
}

Here the exitcode is packaged in an exception so we can extract it from MAIN. This sub might exit with a return so we have to capture that one too.

        $out.exitcode = main();

        CATCH {
            when CapturedExitcode {
                $out.exitcode = .exitcode;
            }

            default {
                say .^name, ': ', .message;
                put .backtrace».Str
            }
        }

Now we need to deal with $*IN and $*OUT. Since the target script just calles lines and that forwards to $*ARGFILES.lines we can use a Channel. One of the Channels is a good place to store the exitcode.

    my $out = Channel.new but role :: { has $.exitcode is rw; };
    my $in = Channel.new but role :: { method put(Any:D \value){ self.send: value ~ $?NL } };

Since lines requires a Str we provide the familiar put-method. Other methods like say would go into the anonymous role too. When the inner MAIN terminates, we want to close the $out channel. We can do so in a LEAVE block. The whole thing can be wrapped into a sub which provides the outer script with a nice interface.

my ($out, $in) = embed-script('./script.raku');

start {
    for ^10 {
        $in.put: $++;
    }
    $in.close;
}

.print for $out.list;

say $out.exitcode;

Dealing with a multi sub MAIN is tricky. If the last statement in the script is &MAIN, it will refer to the dispatcher. With any multi candidate at the end, we can only get hold of the proto by descending into nqp-land.

my &main := $path.IO.slurp.&EVAL;

use nqp;
my &disp = &main.multi ?? nqp::getattr(&main, Routine, '$!dispatcher') !! &main;

We can then call disp() to dispatch to the correct MAIN candidate. I’m not sure if this is fragile. Every routine that is a multi got a dispatcher. Yet Routine.dispatcher is not exposed by CORE.

The whole example can be found here.

Avoiding Proc::Async does speed things up quite a bit. Since we can use a Channel, we don’t have to stringify and parse output when moving data around. The called MAIN needs to cooperate in this case and thus needs to know it is not called by the runtime. We could introduce a new lexical or check $*IN against Channel. There is also the option to check the callframe for EVAL.

constant \frame = gather while my $frame = callframe($++) {
    take $frame
}

say 'indirect' if any frame».gist».starts-with('EVAL');

Quite in contrast to Perl 5, for Raku I never used EVAL much. Not because I’m scared — there was little reason for code generation. After all, between the two of us I have always been the more evil twin.

UPDATE:

As jnthn pointed out, Routine.dispatcher is exposed. We can therefore keep well clear of nqp with:

my &disp = &main.multi ?? &main.dispatcher() !! &main;

As of now, it is unclear if this should be specced and thus documented.

Assumed predictability

Vadim does not agree with me. Nor should he. I hardly ever agree with myself. Also, I’m happy for his disagreement because it allows me to write about a topic that I got in the queue for quite some time.

The basic statement is that enforcing types allows reasoning about interfaces at compile time and maybe even earlier — at brain time. A reasonable thing to do in a statically typed language. When objects are involved, Raku does plenty of its thinking at runtime. Let’s have a look at two examples.

class Foo {
    submethod shift-right($i) { }
}

sub foo(Foo() $handle) {
    $handle.shift-right(4);
}

foo(Foo.new);

class Bar is Foo {
}

foo(Bar.new);

# OUTPUT: No such method 'shift-right' for invocant of type 'Bar'

We ask the compiler for a type check against Foo that Bar satisfied. Then we proceed to call a method on an instance of Bar that is only supplied by Foo. The compiler tried to help us but couldn’t. In this example our interface is not Foo and its methods but only Foo — excluding its child classes — and its methods. This is a subtle difference that will hurt us at runtime. With another example I can illustrate quite clearly why.

class Catchall {
    has $.the-object;
    method FALLBACK($name, |c) {
        self.the-object."$name"(|c)
    }
}

sub foo(Catchall $c) {
    $c.any-name(42);
}

say foo( Catchall.new: the-object =>
    class :: {
        method any-name($i) { 42 ~~ $i ?? 'Universe' !! 'wut‽'  }
    }
);
# OUTPUT: Universe

Can you name the interface that is being used by sub foo? That’s a mean question of course, as the class that supplies the interface got no name. The type constraint provides the interface of an accessor method to $.the-object and anything inherited from Any. The latter might change with new language versions btw. Consequently, the real interface is more like *.any-name() with a type constraint of Any. Those two are simple examples. Any module you use might use MONKEY-TYPING or fiddle with the MOP. Runtime interfaces are utterly unpredictable in Raku and we all do well to use Test.

That being said, Vadim is right to uphold the principle of least surprise. We start the names of roles with a capital to indicate it to be a type object and thus the wish to honour some sort of interface. I would be happy for a more general solution to the problem of “slurpy” coercion. Technically, Raku got the syntax for it already.

sub Filish(Any:D $handle where * ~~ Str|IO::Handle|IO::Path --> IO::Handle) {
    # ... coerce away here
}

sub foo(&Filish() $handle) {
    $handle.put: "This would make me happy!";
}

This form would basically say: “I want the coercion handled by a sub called Filish“. It would allow the code in Filish to be reused and as such provide flexibility, without giving the impression to promise interface. At least in this example the signature of the coercion sub contains its own documentation. There may even be room for some compile time checks, so long as we don’t use a multi. The parameter $handle must satisfy the signature of Filish. Having a sub would allow a module user to .wrap it.

Being in general disagreement with myself can be challenging but does allow me to change my mind easily. Since this is likely my last blog post this year I wish you all exclusively nice reasons to change your minds in 2021.

Coercive files

Many APIs have a routine or two that take a file as an argument. In Raku we can easily turn Str into IO::Path and subsequently into IO::Handle. As a module author it’s a polite move to provide MMD variants, so the user can supply what they like.

sub s($file is copy where { $_ ~~ Str|IO::Path|IO::Handle or fail(&?ROUTINE.name ~ ' likes Str, IO::Path and IO::Handle.') } ) {
    given $file {
        when Str { $file = .IO.open; }
        when IO::Path { $file = .open; }
        when IO::Handle { }
    }

    say ?$file;
}

This is boilerplate. Which in the kingdom of Raku is almost banned. Using the new coercion protocol, we can implement a role to happily save time ever after.

role Filish[*%mode] is IO::Handle {
    proto method COERCE($) {*}
    multi method COERCE(Str:D $s) {
        my $handle = self.new: :path($s.IO);
        $handle.open: |%mode
    }
    multi method COERCE(IO::Path:D $p) {
        my $handle = self.new: :path($p);
        $handle.open: |%mode
    }
    multi method COERCE(IO::Handle:D $h) {
        $h
    }
}

sub f(Filish[:w, :a, :!bin]() $handle) {
    $handle.put: "foo" xx 42;
    $handle.close;
}

f('/tmp/foo.txt');

With the coercing type constraint Filish[:w, :a, :!bin]() we basically say: “Give me something that represents a file, that I will open for writing in the appending fashion.”. I was not aware of the possibility to use a slurpy in the parameter list of a role (*@a works too). This seems to be an ENODOC. Since it makes my file easier I wont complain.

The new coercion protocol is very useful but got one flaw. It forces me to return the type that contains the COERCE-method. In a role that doesn’t make much sense and it forces me to juggle with IO::Handle. It took me 30 minutes to figure out how to successfully subclass it. There may be classes in modules that are even worse. Some programmers really like their private attributes. It would be nice to drop that restrictions on roles and/or if a return type is explicitly provided. With the current model, something easy is made hard.

Anyway, I got it working and might stick a module into the ecosystem, once I came up with a good name.

Making myself a present

My last simple Christmas wish turned out to be quite complex. Testing an idea in actual code can reveal much of the problems that arise from changing CORE concepts. Luckily, we can tweak many things in Raku without changing code in Rakudo. One thing that always bugged me are Mixins of compound types. When mixing in a value, this value will be exposed by a method with the same name as the values’ type object name.

my $a = "foo" but %{ bar => 42 };
say $a.Hash<bar>;
# OUTPUT: 42

This is correct but not very DWIMy. As it turns out we don’t need to do much to change that.

multi sub infix:<but>(Mu \l, Associative \h) {
    constant &BUT = &infix:<but>;
    role MixinAssociative[%h, \v] does Associative {
        has $.the-value = v;
         has %.the-hash handles<AT-KEY EXISTS-KEY DELETE-KEY push iterator list kv keys values> = %h;
    }

    BUT(l, MixinAssociative[h, l]);
}

my $a = "foo" but %{ bar => 42 };
say $a<bar>;
# OUTPUT: 42

I need to stash the original &infix:<but> away to avoid infinite recursion. Any call to raku on a Mixin doesn’t really tell the full story thought.

my $a = "foo" but %{ bar => 42 };
dd $a;
# OUTPUT: Str+{<anon|1>} $a = "foo"

By providing our own raku method in MixinAssociative we can tell the truth.

...
method raku( --> Str ) {
    $!the-value.raku ~ " but " ~ %.the-hash.raku
}
...

my $a = "foo" but %{ bar => 42 };
dd $a;
# OUTPUT: Str+{MixinAssociative[Hash,Str]} $a = "foo" but {:bar(42)}

Changing the semantics of Mixins of values would be quite a drastic change to the language. Having better raku methods on Mixins would not. Yet, there may be fallout in Roast. This shows nicely that there are plenty of ideas left to explore in hopes to improve an already nice language.

Spying on return

Matthew Stuckwisch wrote a module to help with spying on return values. That made me wonder if one could wrap return.

&return.wrap: -> \c { say c; CX::Return.new.throw }
sub s { return 42; }
s;

Output:

42
True
===SORRY!===
control exception without handler
Nil
Some exceptions were thrown in END blocks:
3
Unhandled exception: Too many positionals passed; expected 1 argument but got 2
   at SETTING::src/core.c/Exception.pm6:510  (/usr/local/src/rakudo/install/share/perl6/runtime/CORE.c.setting.moarvm:print_exception)
 from SETTING::src/core.c/Exception.pm6:566  (/usr/local/src/rakudo/install/share/perl6/runtime/CORE.c.setting.moarvm:)

That made me laugh, because Rakudo actually tried to do what I asked it to. By wrapping return we globally change that function. It can’t work because the control exception is thrown in the wrong block. But it doesn’t blow up completely because CORE doesn’t use return.

Since return is an ordinary Sub, there must be a way to throw in the right context.

my &return = -> \c {
    say c;
    use nqp;
    nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, nqp::p6recont_ro(c));
}

sub s { return 42; }
s;

# OUTPUT: 42

That works, is neat but not very helpful. Most routines don’t use a return-statement. To get hold of any return value, we need to wrap the Callable in question. We can use a trait for that.

sub trait_mod<is>:(Callable $c, :$return-spy!) {
    $c.wrap: sub (|c) {
        my \ret = callsame;
        say sprintf('%s(%s): %s', $c.name, c, ret) if $*debug;
        return-rw ret
    };
}

sub f is return-spy { 42 }
my $*debug = True;
f;

# OUTPUT: 42

We could move the conditional of $*debug out of the wrapper to avoid the runtime penalty if no debugging is needed. I’m not sure if that would work well with precomp though. Please note the return-rw.

sub b(\c) { return-rw c }
my $c = 1;
b($c)++; # this won't work without return-rw
say $c;
# OUTPUT: 2

With a simple return, even a sigilless argument will not maintain the container. In fact, using return-rw is almost always required for debugging subs. I left a note with Matthew.

But what about eigenstates?

Shell::Piping can now redirect STDERR to multiple targets. Thanks a lot to lizmat for eigenstates.

use Shell::Piping;
sub coloured-stderr(Int $index is raw, Str $s is raw) {
    my @shade = '38:5:160', '38:5:196';
    $*ERR.put: "\e[@shade[$index]m$s\e[0m";
}

px«find $*HOME» |» px |» '/dev/null'.IO :stderr(&coloured-stderr & '/tmp/pipe.log'.IO & Capture);

This will display the STDERR streams of find and sort in different shades of red, write the same to a logfile and capture STDERR to be used in X::Shell::NonZeroExitcode. I’m quite sure this can also be done in Bash with tee, using lots of parentheses and little -Ofun.

I’m using an all-Junction because it feels right. A use for an any-Junction might be a Routine that takes multiple IO::Path and takes the first found to create a config file. So my Christmas wish list now contains a single entry with a module that can tell Junction types apart.

I wanted Shell::Piping to be able to deal better with STDERR because ffmpeg is outputting both status reports and errors to STDERR. In this case Capture will contain tons of stuff that is not an error message. So I need to be able to collect only a last few lines. Adding another adverb didn’t have much appeal because Shell/Piping.raku contains 21 multi candidates for infix:<|»>. I want to Capture, but only 2 lines. Using :stderr(Capture but 2)looks cool and is easy to implement. Since Capture is not a descendant of Cool it doesn’t come with .Int, unless we mix 2 in. Then we can if-branch on my $limit = $stderr.?Int. That’s good because $stderr ~~ Int:D does not work and Metamodel::Mixins is not helpful either.

I still believe that handling junctions should be in CORE. More thought needs be spend on what junctions are and what can be done with them though. This sounds like a new year resolution. Do we have Raku new year resolutions? It would be nice to hear from the steering council where Raku is heading in 2021.

Santa is pseudo packaging

Santa needs to know where all the chimneys are. Thanks to schedule constraints, a single subroutine call has to do to query multies defined in a bunch of modules.

use v6;

use NSA;
use SIS;
use BND;

sub chimneys {
     do for &chimney.candidates {
         .().Slip
     }
}

This is not very elegant. The sub chimneys should be defined in one of the modules. Since the modules are independent the order of the use-statements must not matter. Simply exporting the same symbol by each module would result in a compile time error. We can place a guard in PROCESS and export only if that guard is not True.

unit module NSA;

multi sub chimney is export {
     # super secret code goes here
}

sub EXPORT {
    sub chimneys {
        do for &CLIENT::chimney.candidates {
            ().Slip
        }
    }

    my %ret;
    if ! try $PROCESS::SANTA-SPY {
        my $PROCESS::SANTA-SPY = True;
        %ret = '&chimneys' => &chimneys;
    }

    %ret
}

When we copy the EXPORT sub into each spy module, Santa does not have to worry about the order of use-statements. Also, the authors of those modules don’t need any coordination when extending their spying. This is important because spooks are incapable to work together not just at Christmas. In the sub chimneys we have to use the pseudo package CLIENT because in each module only one candidate of the multi chimney is visible.

Now Santa can find every single package target without getting near anybody to ask for directions. After all, keeping your distance is an important skill these days.

nomen est omen

Even with the help of his time machine, delivering all presents in a single night keeps Santa extremely busy. With little time to spare he does all his coding in Raku. One of the advantages of time travel, is the option to use the last version of the last programming language.

use v6.∞;

With prizing time so high, wasting it on typing wont make sense. Santa found a way to get double purchase on variable names.

sub drop-package($chimney-id, Channel \p1, Channel \p2) {
     my $stdout = p1.VAR.name.ends-with('-out')
         ?? p1 
         !! p2.VAR.name.ends-with('-out') 
             ?? p2 
             !! fail(‚I don't know what to do with p1‘);

    my $stderr = p1.VAR.name.ends-with('-err')
         ?? p1
         !! p2.VAR.name.ends-with('-err')
             ?? p2
             !! fail(‚I don't know what to do with p1‘);

     px«sledctl --drop-package-in=$chimney-id» |» $stdout :$stderr;
}

my Channel $std-out .= new;
my Channel $std-err .= new;
drop-package(6955057934, $std-out, $std-err);

In Raku we can tell the compiler quite precise how to turn symbols on the caller side to symbols on the callee side. By using a sigilless or is raw parameter in a Signature, we ask not to introducing any new container. When the routine is called either a value or a container is bound to that parameter. Containers got the .VAR method which in turn has a .name method. Since we bind we get the original container from the caller side. With this little trick, Santa does not need to remember the order of positional parameters.

This year I ask Santa for a crowbar so I have a chance to pry my tongue out of my cheek — getting it stuck there is one of the perils of being a blogger.

update:

Lizmat didn’t like Santas ternary operator construct and simplified it a bit.

sub drop-package($chimney-id, Channel \p1, Channel \p2) {       
    sub assign(\target) {       
        my $suffix = target.VAR.name.substr(*-4);       
        target = p1.VAR.name.ends-with($suffix)       
          ?? p1          
          !! p2.VAR.name.ends-with($suffix)         
            ?? p2            
            !! fail       
    }          
                
    assign(my $stdout);       
    assign(my $stderr);       
}

Since we are matching against a string and run some code, we might as well use a lookup table.

sub drop-package($chimney-id, Channel \p1, Channel \p2) {
    my ($stdout, $stderr);
    constant %lookup =
        '-out' => -> \v { $stdout = v },
        '-err' => -> \v { $stderr = v };

    for p1, p2 {
        .&( %lookup{.VAR.name.substr(*-4)} // fail(‚I don't know what to do with ‘ ~ .VAR.name) );
    }

    px«sledctl --drop-package-in=$chimney-id» |» $stdout :$stderr;
 }

A multi with a where-clause that checks against a constant is a lookup table. So we can combine both ideas.

sub drop-package($chimney-id, Channel \p1, Channel \p2) {
    my ($stdout, $stderr);
    
    multi sub assign(\v where {.VAR.name.ends-with('-out')}) { $stdout = v }
    multi sub assign(\v where {.VAR.name.ends-with('-err')}) { $stderr = v }
    
    assign(p1); assign(p2);

    px«sledctl --drop-package-in=$chimney-id» |» $stdout :$stderr;
}

Parallel errors

I wanted to know how long I have to wait for ffmpeg to turn * into AV1. To do so I have to capture STDERR because that’s where ffmpeg outputs the status information while encoding.

my $ffmpeg-out = Channel.new;
my $ffmpeg-err = Channel.new;

react {
    whenever $ffmpeg-err -> [ $stream-num, $_ ] {
        .say if $verbose;
        # boring parsing code goes here
    }
}

px{'nice', '/usr/local/bin/ffmpeg', '-i', $input, '-c:v', 'libsvtav1', '-q', '60', '-preset', '5', '-y', $output} |» $ffmpeg-out :stderr($ffmpeg-err);

The solution is quite simple. I use a Channel to transport lines of text from STDERR to a react block that does the parsing. A nice solution until ffmpeg decides to use STDERR to actually communicate error messages. Those will be gobbled up by the parsing code. As a result the exception that is thrown out of Shell::Piping has no error message to display, beside that a non-zero error code has been returned.

There are quite a few programs that output status to STDERR while operating, so a general approach would be nice. Where messages land is controlled by the adverb :stderr. To capture text to be displayed in the exception is done with :stderr(Capture). So my first impulse was to use a mixin like :stderr($ffmpeg-err but Capture). This would allow me to solve this problem. More complex solutions would be desirable. A user of my module might want to parse STDERR and write everything to a file. Both are currently possible but not at the same time. Providing a list of stream targets would imply order. I’m not sure if I can guarantee that. In the case of multiple channels it would not make sense for sure. In Raku we do have a parallel data type called Junction. In its current form it is not possible to pull a Junction apart. A pull request by lizmat to change that did not find a large fellowship. Luckily she also wrote a module called eigenstates.

use eigenstates;

sub prefix:<\foo> (Str $_, Junction :$err = all Whatever) {
     say $_;
     say eigenstates $err;
 }
 \foo "ello" :err(1|2);

# OUTPUT: ello
          (1 2)

This allows me to do :stderr($ffmpeg-err & Capture) and many more complex operations. For now I don’t see a use in the type of Junction beside all. Since there are still 95 years left in Rakus life cycle, I’m quite sure something will come along.