Coercing the unspeakable

April 17, 2021 3 comments

My wish for typed Supply would be rather limited if we could not coerce to roles.

role R[::T] {}

class A {
    method m(R[Int]() $_) { say $_ ~~ R[Int] }
}

class B {
    method R[Int]() {}
}

# OUTPUT: Missing block
          at /home/dex/projects/raku/tmp/typed-supply.raku:35
          ------>     method R⏏[Int]() {}

So a Signature can ask for a coercion to a parametrised role but a class can’t provide such a method because the compiler doesn’t like the name. From the standpoint of the compiler method names are just strings. The class keyword is just veneer for the MOP.

B.^add_method('R[Int]', method {
    class :: does R[Int] {
    }.new
});
B.^compose;

A.new.m(B.new);

# OUTPUT: True

Having a dynamic compiler for a dynamic language does come with perks. However, using silly method names is not specced. So a problem solving issue is still in order.

Categories: Raku

All your idioms are belong to us

April 16, 2021 2 comments

In the closing thought in my last post I postulated the need to find idioms. That worried me a bit because finding things that are not there (yet) is no easy feat. By chance that day Hacker News linked to an article with well written and explained Python code. We can’t quite translate idioms from one language to another. But if we can steal ideasborrow features from other languages, maybe we can take inspiration for idioms too.

The article by Bart de Goede kindly links to a github repo, where we can find the following piece of code.

import requests


def download_wikipedia_abstracts():
    URL = 'https://dumps.wikimedia.org/enwiki/latest/enwiki-latest-abstract.xml.gz'
    with requests.get(URL, stream=True) as r:
        r.raise_for_status()
        with open('data/enwiki-latest-abstract.xml.gz', 'wb') as f:
            # write every 1mb
            for i, chunk in enumerate(r.iter_content(chunk_size=1024*1024)):
                f.write(chunk)
                if i % 10 == 0:
                    print(f'Downloaded {i} megabytes', end='\r')

This is a very basic implementation of wget. I know very little about Python but I doubt they would be able to implement a complex one for the lack of horizontal space. Python may just be the driving force behind the proliferation of 4K monitors. Being mean aside, the whole idea is that the HTTP component can return an iterator that produces chunks of a given size. Those are written to disk and a progress message is presented.

In Raku iterators are well hidden behind Seq. We also have threadsafe streams in the form of Supply and Channel. To take advantage of this hidden superpower, we need a HTTP client module that can return a Supply. As described in jnthn`s youngest video* we need to get a Supply via .body-byte-stream.

sub download_wikipedia_abstracts {
    use Cro::HTTP::Client;

    constant $abstract-url = 'http://dexhome/enwiki-latest-abstract.xml.gz';
    constant $abstract-file = '/tmp/enwiki-latest-abstract.xml.gz';

    sub MB(Int $i --> Str) {
        sprintf("%.2fMB", $i / 1024 ** 2)
    }

    sub has-time-passed(:$h = 0, :$m = 0, :$s = 1 --> Bool) {
        my $seconds = $h * 60*60 + $m * 60 + $s;
        state $last-time = now;

        if now - $last-time >= $seconds {
            $last-time = now;
            True
        } else {
            False
        }
    }

    with await Cro::HTTP::Client.get: $abstract-url -> $r {
        my $file-length = $r.header('content-length').Int // *;
        with open($abstract-file, :w, :bin) -> $fh {
            say "";
            react whenever $r.body-byte-stream -> Blob \data {
                LAST { progress; $fh.close };
                state $so-far += data.bytes;
                sub progress { print "\r{$so-far.&MB} of {$file-length.&MB} downloaded" }

                $fh.write: data;
                progress if has-time-passed;
            }
        }
    }
}

download_wikipedia_abstracts;

This Raku-version is a bit longer because it shows the correct size of the download in a nicer way. I should not have made fun of Python for its horizontalism. We are only marginally better here. And not just with indentation. This is hardly readable boilerplate rich code. As functions are verbs and objects are nouns, we can try to be a bit more literate.

sub download_wikipedia_abstracts {
    use Cro::HTTP::Client;

    constant $abstract-url = 'http://dexhome/enwiki-latest-abstract.xml.gz';
    constant $abstract-file = '/tmp/enwiki-latest-abstract.xml.gz';

    my $r = await Cro::HTTP::Client.get: $abstract-url;

    my $file-length = $r.header('content-length').Int // *;
    my $fh = open($abstract-file, :w, :bin);
    print "\e[2Kdownloading abstract ";

    $r.body-byte-stream
        ==> progress-indicator(:max-bytes($r.header('content-length').Int // *), :bar-length(20))
        ==> supply-to-file(:path($abstract-file.IO));
}

By using the (sadly underused) feed operator we can nicely show the flow of data of the byte stream through our program. Since Boilerplate never really goes away, we merely put it someplace else.

constant NOP = -> | {;};

multi sub progress-indicator(Supply:D $in, :$max-bytes!, :$bar-length = 10, :&prefix = NOP, :&suffix = NOP, :&speed is copy --> Supply:D) {
    constant @block-chars = (0x2589 .. 0x258F, 0x2591).flat.reverse».chr;
    constant &store-cursor = { print "\e[s" }
    constant &restore-cursor = { print "\e[u" }
    constant &hide-cursor = { print "\e[?25l" }
    constant &show-cursor = { print "\e[?25h" }
    constant &reset-terminal = { print "\ec" }

    sub mega-bits-per-second($so-far) {
        state $last-time = now;
        state $last-bytes = 0;

        if now > $last-time + 2 {
            print ' ', (($so-far - $last-bytes) / (now - $last-time) / 1024**2 * 8).fmt('%.2fMBit/s');

            $last-bytes = $so-far;
            $last-time = now;
        }
    }

    my $out = Supplier::Preserving.new;
    &speed //= &mega-bits-per-second;

    hide-cursor;

    start react whenever $in -> \v {
        LAST { show-cursor; $out.done; }

        state $so-far += v.bytes;
        my $percent = $so-far / $max-bytes * 100;
        my $fraction = (($percent / $bar-length - floor $percent / $bar-length) * 7).round;

        store-cursor;
        prefix $so-far, $max-bytes;

        print '[', @block-chars[*-1] x floor($percent / 100 * $bar-length), ($percent < 100 ?? @block-chars[$fraction] !! ''), "\c[0x2591]" x ($bar-length - floor($percent / 100 * $bar-length)) - 1, ']';

        # &speed ?? speed($so-far) !! mega-bits-per-seconds($so-far);
        speed($so-far);

        suffix $so-far, $max-bytes;

        restore-cursor;

        $out.emit: v;
    }

    $out.Supply
}

multi sub supply-to-file(Supply:D $in, IO::Path :$path, :$blocking) {
    # $io = $io.open(:w, :bin) if $io ~~ IO::Path;
    my $io;

    react whenever $in -> \v {
        state $first = True and ( $first = False; $io = v ~~ Blob ?? $path.open(:w, :bin) !! $path.open(:w) );
        $io.write: v;
    }
}

The feed operator calls its RHS with the return value of the LHS as the last positional parameter. By using named arguments for our stream processors, we end up with just one positional and are a little more descriptive for the (often optional) options. The progress indicator is using NOP to allow :speed(NOP) to disable mega-bits-per-second. Having &prefix and &suffix is done in hopes to make functional programming easy. Checking the type of the first chunk against Blob to decide if we need to open the file in binary mode is a hack. I’m not happy with that.

Sadly Supply and Channel are not typed. They will pass whatever value is emitted to the other side. If they would be parametrised roles that default to Mu I would offload that decision into multi-dispatch. The 2nd hack that emulates FIRST in the react block would also go away. Further, Cro and other stream producers would be easier to document --> Supply[Blob] would suffice. By moving the type check to .emit, consumers of streams would not need to worry about getting the wrong type. Any failed type check would happen closer to the point where the wrong value is produced. Hunting down errors in concurrent code is not fun. Any help is well worth it in this reguard.

As a module author we can mitigate that design shortcoming with mixins.

role Typed[::T] {
    method of { T }
}

role WithLength[$length = *] {
    has $.length = $length;
}

constant BlobSupply = Typed[Blob];

my $s = (Supplier.new.Supply but Typed[Blob]) but WithLength[42];

multi sub f(Supply $s where * ~~ Typed[Blob] & WithLength) {
    say „I got Blobs with a total size of {$s.length} byes.“;
}

multi sub f(Supply $s) {
    fail(‚No can do!‘);
}

f $s;

With the new dispatcher where-clauses are going to be less slow. Yet, a solution in CORE would be much better. As a proper language feature it would get more use. IO::Handle does provide a Supply for read but not for write operations. With typed streams this would be much easier to implement.

Idioms are formed in natural languages to make communication more efficient and precise at the same time. I believe the same is true for PLs. The best idioms are those that are easy to guess the meaning of. With the help of the feed operator and good names that seams to be quite possible. Which leaves the question where we document our idioms. So this needs more thought. Pretty much the only good thing about this pandemic is that we all got more time to do so. The less distractions, the better. I think I gonna play a game now. :-D

*) I was about to write “last video”, what, surprisingly, constitutes as valid English. But we don’t want that. jnthn, please moar of the same! Your VMs and videos are really good.

Categories: Raku

Raku is a match for *

March 11, 2021 2 comments

PimDaniel asked an interesting question.

How do i test match is True while matching : this does NOT work :
if my ($type,$a,$b,$c) = ($v ~~ /^ ('horiz'|'vertic') '_' (\d+) '_' (\d+) '_' (\d+) $/)>>.Str { ... }
Well i made it in 2 times 1/ capture and test the match, 2/ convert the match to Str.

There was no prompt answer and no improvement at all. I couldn’t find a nice way to do this quickly either. In fact it took me the better part of an hour to crack this nut. The main issue here is that a failed match will produce Nil that .Str will complain about. So lets separate boolean check of if and the conversion to Str.

my $a = '1 B';

if $a ~~ /(<digit>) \s (<alpha>)/ -> $_ {
    my ($one, $B) = .deepmap: *.Str;
    say "$one $B";
}
# OUTPUT: 1 B

By forcing the result of the condition expression into the topic, we can run any method on the result of the match, but only if Match.bool returns true. I don’t got a degree in CS* but would be very surprised if Raku-signatures would not turn out to turing complete.

if $a ~~ /(<digit>) \s (<alpha>)/ -> Match (Str() $one, Str() $B) {
    dd $one;
    dd $B;
}
# OUTPUT: "1"
          "B"

The signature of the if block coerces the Match to a list. We pick two elements of it and coerce those to Str. Of cause we could coerce to anything we like based on the position of the captures.

Regexes in Raku are compiled to the same byte code then the rest of the program. In fact grammars are just classes with a funky syntax. That’s why we can run Raku code inside a regex with ease. That means we can turn the whole thing inside out.

my @a = <1 B 3 D 4>;
my @b;

my $hit;

for @a -> $e {
    @b.push: ($e ~~ /(<alpha>) || { next } /).Str;
}

say @b;
# OUTPUT: [B D]

Here we skip the .push if the match does not succeed by skipping the rest of the loop body with next. We could fire any control exception inside the regex. That means we could stick the whole thing into a sub and return the value we are looking for from within the regex.

sub cherry-pick-numeric(Str $matchee) {
    $matchee ~~ m/(<digit>) && { return .Numeric }/;
    Empty
}

@b = do .&cherry-pick-numeric for @a;

dd @b;
# OUTPUT: Array @b = [1, 3, 4]

Raku has been in the making for 10 years. This was an gargantuan task. Now comes the hard bit. We have to take that large language and find all the nice idioms. Good things come to those who wait (on IRC).

*) read: Don’t believe anything I write. You have been warned.

Update:

In truly lazy fashion I came up with a way to turn a match into a lazy list after the work should have been done.

$a = '1B3D4';

my \ll := gather $a ~~ m:g/
      [ <alpha> && { take $/<alpha>.Str } ]
    | [ <digit> && { take $/.<digit>.Numeric } ]
    | [ { say 'step' } ]
/;
say ll[0];
say ll[3];
# OUTPUT: 1
          step
          step
          step
          D

The trick is force the match to run all the way to the end of the string with the :g adverb. This run will be interrupted by a take (by throwing CX::Take) and resumed when the next value is asked from the Seq returned by gather. I don’t know if this is memory efficient thought. There may be a Match instance kept around for each take.

Categories: Raku

Undocumented escape hatch

February 28, 2021 1 comment

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.

Categories: Raku

Custom when

February 25, 2021 1 comment

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‘ }
    }
}
Categories: Raku

Pattern dispatch

February 24, 2021 1 comment

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.

Categories: Raku

Method-ish

February 17, 2021 1 comment

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.

Categories: Raku

Chain calling

January 24, 2021 1 comment

When working with IO::Path we have to take platform dependent directory separator into account. To alleviate the problem .add was added. Surprisingly there is no candidate that takes a list. So we have to chain method calls as if we would use an inferior language.

'/home/dex'.IO.chain.add('tmp').add('foo.txt').say;
"/home/dex/tmp/foo.txt".IO

Since it is rather unlikely that we ever do calculations with IO::Path objects we can repurpose infix:</>. Doing so gives us metaoperators for free.

multi sub infix:</>(IO::Path:D \p is raw, Str:D \s) {
    p.add(s).resolve()
}

multi sub infix:</>(IO::Path:D \p is copy, List:D \l) {
    for l {
        p = p.add: .Str
    }

    p
}

my $p = '/home/dex/'.IO;
$p /= 'bar';
dd $p;
# OUTPUT: Path $p = IO::Path.new("/home/dex/bar", :SPEC(IO::Spec::Unix), :CWD("/"))

Having to chain method calls because the implementer was lazynot overly imaginative is a common theme. Since the default parent class is Any, any method added to that class should show up everywhere.

use MONKEY-TYPING;

augment class Any {
    method chain {
        class Chainer {
            has $.the-object;
            method FALLBACK($name, *@a) {
                my $o = $.the-object;
                for @a -> $e {
                    $o = $o."$name"($e, |%_);
                }

                $o
            }
        }

        Chainer.new(the-object => self)
    }
}

IO::Path.HOW.compose(IO::Path);

'/home/dex'.IO.chain.add(<tmp foo.txt>).say;
# OUTPUT: "/home/dex/tmp/foo.txt".IO

The method chain actually breaks the chain by returning an instance of a private class. This object knows the original object and will change any method call to a loop over the first positional. Named arguments are forwarded via the implicit argument %_.

You likely spotted both “should” and .HOW.compose. This is a long-standing issue. The MOP does keep a list of parent classes but not for children. So neither the compiler nor we can easily walk all type objects to recompose them. It’s a bit of a shame. There is likely much more that could be done in raku.land with a properly working augment.

Categories: Raku

Anonymous slurpers

January 23, 2021 1 comment

I have a script where I’m only interested in the last two lines of its output. That’s easy to handle with Shell::Piping.

px«script.sh ./foo.txt» |» my @a;
my ($second-last-line, $last-line) = @a.tail(2);

That works but is wasteful because it stores lines of text in @a and keeps them around until the Array goes out of scope. Also, any temporary variable is a clear indicator of boilerplate. And we don’t do boilerplate in raku.land.

Declarators are quite powerful because they can take a list and immediately hand it over to infix:<=>. We can even skip values by using anonymous scalars.

my ($, $a, $b) = sub-that-returns-a-list();

I want to do something quite similar. Looking for the last two elements means to skip over any but the last two elements. In subscripts and signatures we use the Whatever * to indicate multiplicity. (Sometimes I don’t get English. Why is “manyness” not a word? o.O)

px«script.sh ./foo.txt» |» my (*, $second-last, $last);

That doesn’t quite work because Rakudo doesn’t expect the whatever star in a declarator list. In fact it doesn’t expect any term in that spot. We can work around that by being explicit. While we are on it we may add an anonymous scalar to the mix.

px«script.sh ./foo.txt» |» my (Whatever, $third-last, $, $last);

Declarators return a List of containers and values. We can use introspection to dissect it.

my \l := my (Whatever, $second-last, $, $last);
say l».&{ .WHAT, .VAR.WHAT, .VAR.name };
# OUTPUT: (((Whatever) Whatever anon) ((Any) Any $second-last) ((Any) Any anon) ((Any) Any $last))

By checking both for type objects and for type object and names in .VAR we can tell *, $ and normal containers apart.

sub infix:<|»>(\l, \r) {
    sub is-whatever($_ is raw) { (.VAR.name eq 'anon' && .WHAT === Whatever) but role :: { method gist { self ?? '*' !! '' } } }
    sub is-anon($_ is raw) { (.VAR.name eq 'anon' && .WHAT === Any) but role :: { method gist { self ?? 'anon' !! '' } } }
    sub is-scalar($_ is raw) { (.VAR ~~ Scalar && .WHAT !=== Whatever && .VAR.name ne 'anon') but role :: { method gist { self ?? 'Scalar' !! '' } } }

    sub is-left-slurpy(\l) { l.head.&is-whatever but role :: { method gist { self ?? 'left-slurpy: yes' !! 'left-slurpy: no' } } }
    sub is-right-slurpy(\l) { l.tail.&is-whatever but role :: { method gist { self ?? 'right-slurpy: yes' !! 'left-slurpy: no' } } }

    say r».&{ .&is-whatever, .&is-anon, .&is-scalar }
    say r.&is-left-slurpy;
    say r.&is-right-slurpy;
}

42 |» my (W, $, $c);
42 |» my ($d, $e, W);

# OUTPUT: ((*  ) ( anon ) (  Scalar))
          left-slurpy: yes
          left-slurpy: no
          ((  Scalar) (  Scalar) (*  ))
          left-slurpy: no
          right-slurpy: yes

Now I have everything I need to teach Shell::Piping to skip over values.

That Rakudo doesn’t allow the Whatever star in declarator lists feels like a bug.

my @List = my (42, "", Cool, $, $a);
dd @List;
Array @List = [Mu, Mu, Cool, Any, Any]

It is perfectly fine to skip over literals, take type objects and keep containers but for whatever reason it doesn’t like stars. However, what does work, works really well. It does provide us with containers that we can reason about via .VAR. Looks like Santa was onto something.

Categories: Raku

Introspective labeling

January 17, 2021 1 comment

IRC is a good place to find answers. Often I find the questions found there to be even more enlightening.

12:26 < notandinus> do other languages have this Label thing? apart from Perl and Raku, i don't seem to find it for python, nim
12:28 < gfldex> notandinus: C/C++ does, but with different semantics (read: you can mess up the stack).
12:30 < sortiz> Javascript also, with semantics similar to Raku.
12:32 < El_Che> isn't label extremely commom to break out of the correct loop?
12:34 < El_Che> Besides python, all other languages probably have it
12:34 < sortiz> But only in Raku they are also objects, like almost everything.
12:35 < notandinus> is it being object better?

So are objects better? That depends on the needs and the attributes or methods provided. Let’s have a look what Label can do for us.

LABEL: Nil;
say LABEL.^attributes;
# OUTPUT: (Str $!name Str $!file Int $!line Str $!prematch Str $!postmatch)
          (new name goto leave Int next redo last gist BUILDALL)

So we get the label name, what means we can label things with them. There are also attributes with the line number and file providing a location for human consumption. With .Str and .gist we get some strings.

Label<94051339353632>
Label<LABEL>(at /home/dex/tmp/tmp2.raku:99, ' ~ self.line } });

⏏LABEL: Nil;

say LABEL.^a')

We do get the line number and file but in a piece of text that we don’t want to parse. Stringification is not helpful and there are no accessors for $!line and $!file. Not to worry, Lord Hanuman is with us.

use MONKEY-TYPING;
augment class Label {
    method Str { $!file ~ ':' ~ $!line }
}

sub documented {
    BEWARE: sub hax { 0x1ee7 }

    warn „Beware of the leet hax at {BEWARE} !“;
}

documented;
# OUTPUT: Beware of the leet hax at /home/dex/tmp/tmp2.raku:113 !
            in sub documented at /home/dex/tmp/tmp2.raku line 115

The class Label feels unfinished to me. With better .Str or access to all attributes it could be a nice tool to refer to spots in source code. This in turn could lead to better error messages and allow folk more creative then me to come up with something clever. I doubt it would be a hard change. I shall query Rakudo’s source code the coming week.

Categories: Raku