Undocumented escape hatch

On my quest to a custom when-statement I did quite a bit of reading. The study of roast and Actions.nqp can lead to great gain in knowledge.

$ less -N S04-statements/given.t
136 # given returns the correct value:
137 {
138      sub ret_test($arg) {
139        given $arg {
140          when "a" { "A" }
141          when "b" { "B" }
142        }
143      }
144
145     is( ret_test("a"), "A", "given returns the correct value (1)" );
146     is( ret_test("b"), "B", "given returns the correct value (2)" );
147 }

As we can see in this example, the spec asks given to return the value provided to succeed. This is an ENODOC. We don’t have to depend on sink to turn the succeed value into a Routines return value.

my $result = do given 'a' {
    CONTROL { default { say 'seen ', .^name } }
    when Str { say 'Str'; succeed('It was a string.'); }
}
dd $result;
# OUTPUT: Str
          Str $result = "It was a string."

It’s a bit odd that we need the do thought, as given will always return at least Nil. The oddity doesn’t stop there. We can get hold of control exceptions. Some of which can return a value. That value is well hidden in nqp-land. Control-exceptions are clearly not an implementation details. So there is no reason for that limitation. Let’s remove it.

given 'a' {
    succeed .Str;
    CONTROL {
        when CX::Succeed {
            use nqp;
            my $vmex := nqp::getattr(nqp::decont($_), Exception, '$!ex');
            my $payload := nqp::getpayload($vmex);
            say 'seen succeed with payload: ', $payload;
        }
        default { say 'seen ', .^name; }
    }
}
# OUTPUT: seen succeed with payload: a

My expedition into nqp-land where started by the discovery, that CX::Succseed and CX::Proceed are swallowed by a hidden monster.

given 'a' {
    CONTROL { default { say 'seen ', .^name } }
    when Str { say 'Str'; succeed('It was a string.'); }
}
# OUTPUT:

$ less -N src/Perl6/Actions.nqp
9932     sub when_handler_helper($when_block) {
9933         unless nqp::existskey(%*HANDLERS, 'SUCCEED') {
9934             %*HANDLERS<SUCCEED> := QAST::Op.new(
9935                 :op('p6return'),
9936                 wrap_return_type_check(
9937                     QAST::Op.new(
9938                         :op('getpayload'),
9939                         QAST::Op.new( :op('exception') )
9940                     ),
9941                     $*DECLARAND) );

The first when or default clause add a fresh handler and only checks for SUCCEED and ignores any CONTROL blocks already present. Given that intercepting X::Control is specced, this is rather surprising.

Alas, adding exception handlers via macros, doesn’t work right now. This is not a pressing issue because macros are subject to change my RakuAST anyway and I might get the desired result with a Slang.

Custom when

I didn’t quite like the syntax of using match in the last post. The commas in the list of its arguments looked strangely out of place. Maybe because my eyes are used to a given block. Sleeping over it helped.

sub accord(&c) { (c(CALLER::<$_>); succeed) if &c.cando(\(CALLER::<$_>)) }

given Err.new(:msg<a>) {
    accord -> Hold (:$key) { put „holding $key“; }
    accord -> Err (:$msg) { warn „ERR: $msg“ }
    default { fail ‚unsupported‘ }
}

This works because accord mimics what when is doing. It does some matching, calls a block when True and adds a succeed (by throwing a control exception) at the end of each block. All given is doing is setting the topic. It also acts as a CALLER so we can access its $_ via a pseudo package. Using the signature of a pointy to do deconstruction is quite powerful. Adding this to CORE might be a good idea.

We may have to change the definition of Rako to: “Raku is a highly composable programming language, where things just fall into place.”

UPDATE:

There are cases where $_ is not a dynamic. Also, succeed is throwing a control exception and the handler for those are added by when or default. This happens at compile time and can’t currently be done with macros. The first problem is solvable with black magic. The latter requires a default-block. I didn’t find a way to provide a sensible error message if that block is missing.

multi sub accord(&c) {
    use nqp;
    $_ := nqp::getlexcaller('$_');
    (c($_); succeed) if &c.cando(\($_))
}

for @possibilities.roll(1) -> $needle {
    given $needle {
        accord -> Hold (:$key) { put „holding $key“; }
        accord -> Err (:$msg) { warn „ERR: $msg“ }
        default { warn ‚unsopported‘ }
    }
}

Pattern dispatch

The ever helpful raiph wished for RakuAST in an answer to a question about pattern matching like it is done in Haskell. It was proposed to use MMD to solve this problem. Doing so and getting a fall-through default was unsolved. Since dispatch simply is pattern matching we just need to do some extra work. In a nutshell, the dispatcher gets a list of functions and a list with arguments. The first function that takes all arguments wins.

class Hold { has $.key; }
class Press { has $.key; }
class Err { has $.msg; }

sub else(&code) { &code }

sub match($needle, *@tests) {
    for @tests.head(*-1) -> &f {
        if &f.cando(\($needle)) {
            return f($needle);
        }
    }
    @tests.tail.();
}

match Hold.new(:key<a>),
    -> Hold (:$key) { put „holding $key“; },
    -> Press (:$key) { put „pressing $key“; },
    -> Err (:$msg) { warn „ERR: $msg“ },
    else { fail ‚unsopported‘ };

The method .cando needs a Capture to tell us if a Routine can be called with a given list of arguments. To create such a Capture we use the literal \($arguments, $go, $here). We don’t test the default at the end. Instead we call that function when no other function matches. Declaring the sub else is just for cosmetics.

Since we are in functional land we can use all the convenient features Raku provides us with.

my &key-matcher = &match.assuming(*,[
        -> Hold (:$key) { put „holding $key“; },
        -> Press (:$key) { put „pressing $key“; },
        -> Err (:$msg) { warn „ERR: $msg“ },
        else { fail ‚unsopported‘ };
]);

sub key-source {
    gather loop {
        sleep 1;
        take (Hold.new(:key<a>), Press.new(:key<b>), Err.new(:msg<WELP!>), 'unsupported').pick;
    }
}

.&key-matcher for key-source;

We have to help .assuming a little to understand slurpies by putting the list of functions in an explicit Array.

There is always a functional way to solve a problem. Sometimes we can even get a neat syntax out of it.

Method-ish

In my last post I once again struggled with augmenting classes from CORE. That struggle wasn’t needed at all as I didn’t change state of the object with the added method. For doing more advanced stuff I might have to. By sticking my hand so deep into the guts of Rakudo I might get myself burned. Since what I want to do is tying my code to changes the compiler anyway, I might as well go all in and decent into nqp-land.

my \j = 1 | 2 | 3;
dd j;
use nqp;
.say for nqp::getattr(j, Junction, '$!eigenstates');
# OUTPUT: any(1, 2, 3)
          1
          2
          3

We can use nqp to get hold of private attributes without adding any methods. That’s a bit unwildy. So let’s do some deboilerplating with a pseudo-method.

sub pry(Mu $the-object is raw) {
    use InterceptAllMethods;

    class Interceptor {
        has Mu $!the-object;
        method ^find_method(Mu \type, Str $name) {
            my method (Mu \SELF:) is raw {
                use nqp;
                my $the-object := nqp::getattr(SELF, Interceptor, '$!the-object');
                nqp::getattr($the-object, $the-object.WHAT, '$!' ~ $name)
            }
        }
    }

    use nqp;
    nqp::p6bindattrinvres(nqp::create(Interceptor), Interceptor, '$!the-object', $the-object);
}

.say for j.&pry.eigenstates;
# OUTPUT: 1
          2
          3

With InterceptAllMethods lizmat changed the behaviour of the class-keyword to allow us to provide a FALLBACK-method that captures anything, including methods inherited from Mu. That in turn allows the object returned by pry to divert any method call to a custom method. In this method we can do whatever we want with the object .&pry is called with.

Since our special object will intercept any call, even those of Mu, we need to find another way to call .new. Since .^ is not a special form of . we can use it to get access to class methods.

sub interceptor(Method $the-method){
    use InterceptAllMethods;
    use nqp;

    sub (Mu $the-object is raw) {
        my class Interceptor {
            has Mu $!the-object;
            has Code $!the-method;

            method ^find_method(Mu \type, Mu:D $name) {
                my method (Mu \SELF: |c) is raw {
                    $!the-method.($!the-object, $name, |c)
                }
            }
            method ^introspect(Mu \type, Mu \obj) {
                my method call-it() is raw {
                    $!the-object
                }
                obj.&call-it;
            }
            method ^new(Mu \type, $the-object!, $the-method) {
                nqp::p6bindattrinvres(
                        nqp::p6bindattrinvres(nqp::create(Interceptor), Interceptor, '$!the-object', $the-object),
                        Interceptor, '$!the-method', $the-method)
            }
        }

            # nqp::p6bindattrinvres(
                #     nqp::p6bindattrinvres(nqp::create(Interceptor), Interceptor, '$!the-object', $the-object),
                #   Interceptor, '$!the-method', $the-method);
        Interceptor.^new($the-object, $the-method)
    }
}

my &first-defined = interceptor(
    my method (Positional \SELF: $name) {
        for SELF.flat -> $e {
            with $e."$name"(|%_) {
                .return
            }
        }
        Nil
    }
);

my $file = <file1.txt file2.txt file3.txt nohup.out>».IO.&first-defined.open(:r);
dd $file;
# OUTPUT: Handle $file = IO::Handle.new(path => IO::Path.new("nohup.out", :SPEC(IO::Spec::Unix), :CWD("/home/dex/projects/raku/tmp")), chomp => Bool::True, nl-in => $["\n", "\r\n"], nl-out => "\n", encoding => "utf8")

The sub interceptor takes a method and returns a sub. If that sub is called like a method, it will forward both the name of the to be called method and the invocant to a custom method. When .&first-defined is called a special object is returned. Let’s have a look what it is.

my \uhhh-special = <a b c>.&first-defined;
dd uhhh-special.^introspect(uhhh-special);
# OUTPUT: ($("a", "b", "c"), method <anon> (Positional \SELF: $name, *%_) { #`(Method|93927752146784) ... })

We have to give .^introspect the object we want to have a look at because its invocant is the type object of the class Interceptor.

Currently there is no way known to me (After all, I know just enough to be really dangerous.) to export and import from EXPORTHOW in the same file. That is unfortunate because lizmat decided to overload the keyword class instead of exporting the special Metamodel::ClassHOW with a different name. If we don’t want or can’t have external dependencies, we can use the MOP to create our type object.

class InterceptHOW is Metamodel::ClassHOW {
    method publish_method_cache(|) { }
}

sub ipry(Mu $the-object is raw) {
    my \Interceptor = InterceptHOW.new_type(:name<Interceptor>);
    Interceptor.^add_attribute(Attribute.new(:name<$!the-object>, :type(Mu), :package(Interceptor)));
    Interceptor.^add_meta_method('find_method',
        my method find_method(Mu \type, Str $name) {
            # say „looking for $name“;
            my method (Mu \SELF:) is raw {
                use nqp;
                my $the-object := nqp::getattr(SELF, Interceptor, '$!the-object');
                nqp::getattr($the-object, $the-object.WHAT, '$!' ~ $name)
            }
    });
    Interceptor.^compose;

    use nqp;
    nqp::p6bindattrinvres(nqp::create(Interceptor), Interceptor, '$!the-object', $the-object);
}

While I wrote this I discovered that .^add_meta_method only works if the method provided to it got the same name as the Str in its first argument. At first I tried an anonymous method which ended up in .^meta_method_table but was never called. I guess this bug doesn’t really matter because this meta-method isn’t documented at all. If I play with dragons I have no right to complain about burns. You will spot that method in the wild in Actions.nqp. There is no magic going on with the class-keyword. Rakudo is just using the MOP to construct type objects.

We can’t overload the assignment operator in Raku. That isn’t really needed because assignment happens by calling a method named STORE. Since we got full control over dispatch, we can intercept any method call including a chain of method calls.

multi sub methodify(%h, :$deeply!) {
    sub interceptor(%h, $parent = Nil){
        use InterceptAllMethods;
        use nqp;

        class Interceptor is Callable {
            has Mu $!the-object;
            has Mu @!stack;

            method ^find_method(Mu \type, Mu:D $name) {
                my method (Mu \SELF: |c) is raw {
                    my @new-stack = @!stack;
                    my $the-object = $!the-object;

                    if $name eq 'STORE' {
                        # workaround for rakudobug#4203
                        $the-object{||@new-stack.head(*-1)}:delete if $the-object{||@new-stack.head(*-1)}:exists;

                        $the-object{||@new-stack} = c;
                        return-rw c
                    } else {
                        @new-stack.push: $name;
                        my \nextlevel = SELF.^new($!the-object, @new-stack, $name);
                        nextlevel
                    }
                }
            }
            method ^introspect(Mu \type, Mu \obj) {
                my method call-it() is raw {
                    $!the-object, @!stack
                }
                obj.&call-it;
            }
            method ^new(Mu \type, $the-object!, @new-stack?, $name?) {
                $name
                    ?? nqp::p6bindattrinvres(
                        nqp::p6bindattrinvres(nqp::create(Interceptor), Interceptor, '$!the-object', $the-object),
                        Interceptor, '@!stack', @new-stack)
                    !! nqp::p6bindattrinvres(nqp::create(Interceptor), Interceptor, '$!the-object', $the-object)
                }
        }

        Interceptor.^new(%h)
    }

    interceptor(%h)
}

my %h2;
my $o2 = methodify(%h2, :deeply);
$o2.a.b = 42;
dd %h2;
$o2.a.b.c = <answer>;
dd %h2;
say $o2.a.b.c;
# OUTPUT: Hash %h2 = {:a(${:b(\(42))})}
          Hash %h2 = {:a(${:b(${:c(\("answer"))})})}
          This type cannot unbox to a native string: P6opaque, Interceptor
            in block <unit> at /home/dex/projects/raku/any-chain.raku line 310

Every time we call a method a new instance of Interceptor is created that stores the name of the previous method. That way we can move along the chain of method calls. Since assignment calls STORE, we can divert the assignment to the Hash we use as an actual data structure. Alas, retrieving values does not work the same way because Raku does not distinguish between method call and FETCH. Here the dragon was stronger then me. I still included this halve failed attempt because I had good use for slippy semi lists. This requires use v6.e.PREVIEW and allowed me to step on a bug. There are likely more of those. So please use the same so we can get all the beasties slain before .e is released into the wild.

Having full control over chains of method calls would be nice. Maybe we can do so with RakuAST.

With the things that do work already we can do a few interesting things. Those pesky exceptions are always slowing our progress. We can defuse them with try but that will break a method call chain.

constant no-argument-given = Mu.new;
sub try(Mu $obj is raw, Mu $alternate-value = no-argument-given) {
    interceptor(my method (Mu \SELF: $name, |c) {
        my $o = SELF;
        my \m = $o.^lookup($name) orelse {
            my $bt = Backtrace.new;
            my $idx = $bt.next-interesting-index($bt.next-interesting-index + 1);
            (X::Method::NotFound.new(:method($name), :typename($o.^name)) but role :: { method vault-backtrace { False }}).throw(Backtrace.new($idx + 1));
        }

        try {
            $o = $o."$name"(|c);
        }
 
        $! ~~ Exception
            ?? $alternate-value.WHICH eqv no-argument-given.WHICH
                ?? $o
                !! $alternate-value
            !! $o
    }).($obj)
}

class C {
    has $.greeting;
    method might-throw { die "Not today love!" }
    method greet { say $.greeting }
}

C.new(greeting => ‚Let's make love!‘).&try.might-throw.greet;
# OUTPUT: Let's make love!

The pseudo-method try will defuse any exception and allows to just carry on with calling methods of C. I have to mark the absence of the optional parameter $alternate-value with a special value because one might actually turn the exception object into Nil.

I’m quite sure there are many more such little helpers waiting to be discovered. There may be a module in the future, hopefully helping to make Raku a good programming language.