Created
March 7, 2023 19:46
-
-
Save gfldex/3bb53da68917dee0890444143f6a1245 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use v6.*; | |
# my $a = '1 B'; | |
# | |
# if $a ~~ /(<digit>) \s (<alpha>)/ -> $_ { | |
# my ($one, $B) = .deepmap: *.Str; | |
# say "$one $B"; | |
# } | |
# | |
# if $a ~~ /(<digit>) \s (<alpha>)/ -> Match (Str() $one, Str() $B) { | |
# dd $one; | |
# dd $B; | |
# } | |
# | |
# | |
# my @a = <1 B 3 D 4>; | |
# my @b; | |
# | |
# my $hit; | |
# | |
# for @a -> $e { | |
# @b.push: ($e ~~ /(<alpha>) || { next } /).Str; | |
# } | |
# | |
# sub cherry-pick-numeric(Str $matchee) { | |
# $matchee ~~ m/(<digit>) && { return .Numeric }/; | |
# Empty | |
# } | |
# | |
# @b = do .&cherry-pick-numeric for @a; | |
# | |
# dd @b; | |
# | |
# say 'mark'; | |
# $a = '1B3D4'; | |
# | |
# my \ll := gather $a ~~ m:g/ | |
# [ <alpha> && { take $/<alpha>.Str } ] | |
# | [ <digit> && { take $/.<digit>.Numeric } ] | |
# | [ { say 'step' } ] | |
# /; | |
# say ll[0]; | |
# say ll[3]; | |
# | |
# | |
# sub nil-is-bad(\v) { | |
# die "bad Nil is bad" if v eqv Nil; | |
# v | |
# } | |
# $a = '1 B'; | |
# | |
# if nil-is-bad($a ~~ /(<digit>) \s (<alpha>)/) -> Match (Str() $one, Str() $B) { | |
# say "got $one and $B but not Nil"; | |
# } | |
### | |
# class SuperInt { | |
# has $.left-factor is rw; | |
# has $.right-factor is rw; | |
# method new(\l, \r) { | |
# my \SELF = self.CREATE; | |
# SELF.left-factor = l; | |
# SELF.right-factor = r; | |
# SELF | |
# } | |
# } | |
# | |
# multi sub infix:<÷>(Numeric:D \l, SuperInt:D \r) { | |
# l ÷ r.left-factor * r.right-factor | |
# } | |
# | |
# Int.^add_method('CALL-ME', my method (\SELF: \v) { SuperInt.new(SELF, v) }); | |
# Int.^compose; | |
# | |
# say 60÷5(7−5); | |
# sub chain-coerce(@list, *@types) { | |
# dd @list; | |
# do for @list Z @types -> [\e, \T] { | |
# my $type-name = T.^name; | |
# dd $type-name; | |
# e."$type-name"() | |
# } | |
# } | |
# | |
# { # Moving the pattern to var which we interpolate into match | |
# my $input = 'There are 9 million bicycles in beijing.'; | |
# my $pattern = rx{ (\d+) \s+ (\w+) }; | |
# if $input ~~ / <$pattern> / -> $m { | |
# say $m[0]; | |
# say $0.^name; # Nil | |
# say $0; # Nil | |
# say $1.^name; # Nil | |
# say $1; # Nil | |
# say $/; # 「9 million」 | |
# } | |
# } | |
# | |
# enum DebugLevel <little much most>; | |
# | |
# my $*debug; | |
# | |
# $*debug = little; | |
# | |
# dd $*debug; | |
# | |
# $*debug = any $*debug, 42; | |
# | |
# say $*debug ~~ 42; | |
# | |
# $*debug = any $*debug, 'answer'; | |
# | |
# say $*debug; | |
# | |
# my Int $a = 10; role Foo[$a] {}; role Bar[Int $a] does Foo[$a] {} | |
# | |
# for (:a, :!b, :c('str'), 12, :k('42'), :d(42), :e(55), '47', '55', 'foo') { | |
# when Pair & :value(Bool & :so) { dd $_ } | |
# when Pair & :value(Bool & :!so) { dd $_ } | |
# when Pair & :value(Str) { dd $_ } | |
# when Pair & :value(42) { dd $_ } | |
# when Pair & :value(Int) { dd $_ } | |
# when Str & :Int & 47 { dd $_ } | |
# when Str { dd $_ } | |
# when Int { dd $_ } | |
# } | |
# | |
# my \v = :value(Bool & :so); | |
# dd v; | |
# say :so.WHAT; | |
# dd :so.value; | |
# my @a = <a b c>; my @b = 1,2,3; my @c := -> *@c { @c }(@a, @b); dd @c; | |
# my @a = <a b c>; my @b = 1,2,3; my (*@c) := @a, @b; dd @c; | |
# | |
# sub spy(\v) { say v with v; v }; (my @sparce)[0,2,3] = 1,3,4; loop { last without spy @sparce[$++] } | |
# react whenever Supply.interval(1) { | |
# state $first = True; | |
# $first and ( $first = False; say 'first' ); | |
# .say | |
# } | |
# role R { | |
# method m() { say $?CLASS } | |
# } | |
# | |
# my $c = class SomeName does R {}; | |
# $c.m; | |
# | |
# my $emitter = Supplier.new; | |
# my $s = $emitter.Supply; | |
# my $p = start { | |
# loop { | |
# $emitter.emit: [42, 'answer', Any].roll; | |
# sleep 0.25; | |
# } | |
# } | |
# for $s.Channel.list -> \v { | |
# given v { | |
# when Int { say .WHAT } | |
# when Str { say .WHAT } | |
# when Any:U { say 'undefined' } | |
# when Failure { .Bool; say .message; } | |
# } | |
# } | |
# multi sub m(Int $_) { | |
# say .WHAT; | |
# } | |
# | |
# multi sub m(Str $_) { | |
# say .WHAT; | |
# } | |
# | |
# multi sub m(Any:U $_) { | |
# say 'undefined'; | |
# } | |
# | |
# multi sub m(Failure $_ is raw) { | |
# say .WHAT; | |
# } | |
# | |
# sub handle-with(Supply:D $s, *@routines) { | |
# my proto pseudo-multi(|) {*} | |
# for @routines -> &b { | |
# &pseudo-multi.add_dispatchee(&b); | |
# } | |
# | |
# $s.tap: &pseudo-multi; | |
# } | |
# | |
# handle-with($s, | |
# sub (Int $_) { say .WHAT }, | |
# sub (Str $_) { say .WHAT }, | |
# sub (Any:U $_) { say 'undefined' }, | |
# # sub (Failure) { say .message; .so; } | |
# ); | |
# | |
# await $p; | |
# class C { | |
# method ^parameterize(\T, \v) { dd T, v; C.new } | |
# } | |
# | |
# my $c = C[42]; | |
# dd $c; | |
# | |
# class NotNil is Nil { | |
# method new { self.CREATE } | |
# } | |
# | |
# class C { method NotNil() { NotNil.new } }; sub s(NotNil()) {}; s(C.new); | |
# class NotNil is Nil {}; | |
# | |
# class C { | |
# method NotNil() { NotNil.new } | |
# }; | |
# | |
# sub s(NotNil()) {}; | |
# | |
# s(NotNil.new); | |
# | |
# dd NotNil.new | |
my Int $a = 42; | |
constant \T := $a.VAR.of; | |
# my $b is T; | |
my $b where $a.WHAT = 123; | |
# say [3,5,1,2,3].grep({say $_; $_ !%% 2 or die('bailing')}).unique; | |
# OUTER: for 1 { | |
# last OUTER; | |
# }; | |
# my $string = "wowoeroiueawr 2 to 4"; | |
# sub type-map(\match, *@types) { | |
# my %index-to-type = @types.kv; | |
# match.caps.map: { .value."{%index-to-type{.key}.^name}"() }; | |
# } | |
# my @pos = ($string ~~ m/(.+) " " (\d) " to " (\d)/).&type-map(Str, Int, Int); | |
# dd @pos; | |
# my ($s1, $i1, $i2) = ($string ~~ m/(.+) " " (\d) " to " (\d)/).&type-map(Str, Int, Int); | |
# my regex re { ^'abc' }; | |
# say 'abc' ~~ /<re>/; | |
# my $re = /\w+/; | |
# say 'ab c' ~~ / $re /; | |
# my $foo = "a+b"; | |
# dd "aaaaab" ~~ m/<{$foo}>/; | |
# proto sub type-map(+@) {*} | |
# multi sub type-map(+@ [] --> Empty) { } | |
# multi sub type-map(*@ [::T, T() \x, **@xs]) { x, |@xs.&type-map } | |
# | |
# my $string = "wowoeroiueawr 2 to 4"; | |
# $string ~~ / (.+) ' ' (\d) ' to ' (\d) /; | |
# say type-map @$/ R[Z] Str:D, Int:D, Int:D; | |
# | |
# constant term:<$☺> := $; say ++$☺; | |
# | |
# my %h; | |
# %h{||<1 2 3>} = 42; | |
# dd %h; | |
# | |
# my &b = { 42 }; &b.say; | |
# my $buff = Buf.new( 0xff.rand.Int xx 200 ); dd $buff.elems; | |
# | |
# say "9 of spades".subst(/(\d+)/, -> Match:D ( $n, *@ ) { $n + 1 }); | |
# | |
# constant all-channels := none(); | |
# | |
# my $j = all-channels; | |
# | |
# dd $j; | |
# # $j = '#general#raku'; | |
# | |
# my $c = $j.split('#', :skip-empty).any; | |
# dd $c; | |
# say $c ~~ 'private'; | |
# | |
# say ().none ~~ 'name'; | |
# | |
# say %*ENV{%*ENV.grep(/^ SSH/)».key}:delete; | |
# say %*ENV; | |
# my $c = "#-raku-irc#-raku-dev-irc#-moarvom-irc#-webring-irc#raku"; | |
# $c = $c.split('#').&{ any( .cache.grep(/^ '-'/)».subst(/^ '-'/).none, .grep(/^ <-[-]>/).any) } | |
# dd $c; | |
# | |
# | |
# my regex identifier { | |
# <[a..z A..Z 0..9 . -]>+ | |
# } | |
# | |
# # say <irc.libera.chat#raku irc.libera.chat#raku-dev>.all ~~ /<identifier>+ '#' <identifier>/; | |
# for <irc.libera.chat#raku irc.libera.chat#raku-dev>».&{ m/(<identifier>) '#' (<identifier>)/.list».Str } -> [$server, $channel] { | |
# say [$server, $channel]; | |
# } | |
# | |
# class OnMessage does Callable { | |
# has $.state is rw; | |
# has &.callback; | |
# method CALL-ME(&callback) { self.Supply.tap: &callback } | |
# method Supply { Supplier.new.&{ start loop { sleep ¼; .emit: $++; .done if $++ > 2 }; .Supply } } | |
# } | |
# | |
# my &on-message = OnMessage.new; | |
# &on-message.state = 42; | |
# # react whenever &on-message { .say } | |
# on-message({ .say }); | |
# | |
# sub api-entry { stream => Supplier.new, 'answer' => -> { 42 }, 'unused' => {;} } | |
# | |
# with api-entry() -> (:$stream, :&answer, *%_) { | |
# dd $stream, &answer; | |
# } else { fail('bad‼'); } | |
# | |
# sub discord(|c) { | |
# say c[0][0].VAR.name; | |
# } | |
# discord(my ($message, $status)); | |
# | |
# dd $message, $status; | |
# sub s($a) { $a + 1 } | |
# | |
# say s(Junction.new('all', (42,45))); | |
# class C { | |
# has @.a is required; | |
# submethod TWEAK { | |
# die(‚class C is not feeling so well.‘) unless +@!a; | |
# } | |
# method a() { return-rw Proxy.new( | |
# FETCH => sub ($) { @!a }, | |
# STORE => sub ($, @new-a) { die ‚I want moar!‘ unless +@new-a; @!a := @new-a; } | |
# )} | |
# } | |
# | |
# constant $c = C.new(:a([1])); | |
# say $c.a; | |
# say $c.a = 1,2,3; | |
# say $c.a = []; | |
# my @a = 1..100; | |
# | |
# say (1..100).map: { .&next if .is-prime }; | |
# | |
# sub oi(@a) is pure { @a[*]:delete }; my @a = <1 2 3>; oi(@a); dd @a; | |
# sub whatever (List() $x) { shift $x } ; my @y = 1..3; whatever(@y); @y.say | |
# my &b = { … }; my &wc = * - 1 + *; my &p = -> { … }; (&b, &wc, &p)».signature».say; | |
# use MONKEY-SEE-NO-EVAL; | |
# my $chars = "cool".comb.unique.join; | |
# my $cc = EVAL 'my regex { <[' ~ $chars ~ ']> }'; | |
# my $foo = "cOOL"; say $foo ~~ /:i <$cc> /; | |
# .say for gather ($(12,84),).deepmap: *.take; | |
# my &s = sub { say 42 }; | |
# constant c = Channel.new; | |
# start react whenever c -> &s { s() } | |
# c.send(&s) for ^3; | |
# sleep 1; | |
# my Int() $sailors = @*ARGS.shift // 5; | |
# dd $sailors; | |
# my Date() $when = @*ARGS.shift // now; | |
# dd $when; | |
# sub MAIN( | |
# #| Dudes on (or formerly on) ships. | |
# Int $sailors, | |
# #| Why does the monkey never gets proper credit? | |
# Str :$monkey-name = "Bob", | |
# ) { | |
# dd $sailors; | |
# } | |
# my $input = '{ say "hello haxor!" }'; say 'ohai' ~~ /<$input>/; | |
# say :($a;; $b) ~~ :($a); | |
# my module Signal { | |
# our sub connect { | |
# say CLIENT::LEXICAL::.keys; | |
# my $o1 := CLIENT::LEXICAL::<$o1>; | |
# dd $o1; | |
# } | |
# } | |
# class C { | |
# method there { 42 } | |
# } | |
# | |
# constant NOT-THERE = ‚ENOTTHERE‘; | |
# | |
# my $c = C.new; | |
# | |
# my $v1 = $c.there; | |
# my $v2 = sub { return $c.not-there; CATCH { when X::Method::NotFound { return NOT-THERE } } }.(); | |
# | |
# dd $v1, $v2; | |
# $*IN = class :: is IO::Handle { | |
# has @.lines = <1 2 3>; | |
# method lines { gather { while @!lines { take shift @!lines } } } | |
# method nl-in(|) { } | |
# method chomp(|) { } | |
# method encoding(|) { } | |
# method IO { self } | |
# method open { self } | |
# method get { shift @!lines } | |
# }.new; | |
# | |
# multi sub MAIN(IO::Handle:D $handle) { | |
# say $handle.get; | |
# say $handle.lines; | |
# } | |
# | |
# multi sub MAIN(IO(Str) $in-file) { } | |
# | |
# multi sub MAIN() { MAIN($*IN) } | |
# sub infix:<yy>(&c, $n) { ^$n .map: &c } | |
# | |
# sub s() { state $++ } | |
# | |
# say { s } yy 10; | |
# subset Sane of Numeric where { ( .?denominator // 1 ) != 0 } | |
# | |
# my Sane:D $i = 42; | |
# $i = ½; | |
# $i = 1 / 0; | |
# subset Sane of Numeric where { | |
# ( .?denominator // 1 ) != 0 | |
# or fail("defusing 0 denominator in " ~ Backtrace.new.list.grep({!.is-setting})[1].&{.file ~ ' line ' ~ .line}) | |
# } | |
# | |
# my Sane:D $i = 42; | |
# $i = ½; | |
# $i = 1 / 0; | |
# say 1 ∈ (1/1, )».Int; | |
# proto sub infix:<(elem)>($, $, *% --> Bool:D) is pure {*} | |
# multi sub infix:<(elem)>(Numeric:D \a, Iterable:D \listy --> Bool:D) { | |
# Any.fail-iterator-cannot-be-lazy('∈', '') if listy.is-lazy; | |
# | |
# for listy -> \b { | |
# # return True if &*SET-COMPARATOR(a, b); | |
# return True if a == b; | |
# } | |
# | |
# False | |
# } | |
# | |
# multi sub infix:<(elem)>(Numeric:D \a, Setty:D \setty --> Bool:D) { | |
# Any.fail-iterator-cannot-be-lazy('∈', '') if setty.is-lazy; | |
# | |
# for setty.keys -> \b { | |
# return True if a == b; | |
# } | |
# | |
# False | |
# } | |
# | |
# constant &infix:<∈> := &infix:<(elem)>; | |
# | |
# proto sub infix:<(&)>(|) is pure {*} | |
# multi sub infix:<(&)>(Iterable:D \lhs, Iterable:D \rhs) { | |
# Any.fail-iterator-cannot-be-lazy('∩', '') if lhs.is-lazy || rhs.is-lazy; | |
# | |
# my @result; | |
# | |
# for lhs -> \l { | |
# for rhs -> \r { | |
# @result.push: r if l == r; | |
# } | |
# } | |
# | |
# +@result ?? @result.Set !! ∅ | |
# } | |
# | |
# multi sub infix:<(&)>(Iterable:D \lhs, Setty:D \rhs) { | |
# Any.fail-iterator-cannot-be-lazy('∩', '') if lhs.is-lazy || rhs.is-lazy; | |
# | |
# my @result; | |
# | |
# for lhs -> \l { | |
# for rhs.keys -> \r { | |
# @result.push: r if l == r; | |
# } | |
# } | |
# | |
# +@result ?? @result !! ∅ | |
# } | |
# | |
# multi sub infix:<(&)>(Setty:D \lhs, Iterable:D \rhs) { | |
# Any.fail-iterator-cannot-be-lazy('∩', '') if lhs.is-lazy || rhs.is-lazy; | |
# | |
# my @result; | |
# | |
# for lhs.keys -> \l { | |
# for rhs -> \r { | |
# @result.push: r if l == r; | |
# } | |
# } | |
# | |
# +@result ?? @result !! ∅ | |
# } | |
# | |
# multi sub infix:<(&)>(Setty:D \lhs, Setty:D \rhs) { | |
# Any.fail-iterator-cannot-be-lazy('∩', '') if lhs.is-lazy || rhs.is-lazy; | |
# | |
# my @result; | |
# | |
# for lhs.keys -> \l { | |
# for rhs.keys -> \r { | |
# @result.push: r if l == r; | |
# } | |
# } | |
# | |
# +@result ?? @result !! ∅ | |
# } | |
# | |
# constant &infix:<∩> := &infix:<(&)>; | |
# | |
# my &*SET-COMPARATOR = &infix:<==>; | |
# my $t; | |
# { | |
# $t = 1 ∈ (1/1, ) for ^1000000; | |
# say now - ENTER now; | |
# } | |
# say 1 ∈ (1/1, ).Set; | |
# # say (42, 42/2, 42/3) ∩ (1..∞).lazy; | |
# say (42, 42/2, 42/3) ∩ (1, 21, 3); | |
# say (42, 42/2, 42/3) ∩ (1, 21, 3).Set; | |
# say (42, 42/2, 42/3).Set ∩ (1, 21, 3); | |
# say (42, 42/2, 42/3).Set ∩ (1, 21, 3).Set; | |
# | |
# say 1 ~~ 1/1; | |
# | |
# my $n1 = 2; | |
# my $n2 = 1/1; | |
# my $n3 = 1.1; | |
# | |
# say (1, 1/1, 1.1, 2)».Rat».&{ .denominator == 1 }; | |
# | |
# say '1A2B' ~~ m:g/(<[\D] - [-]>+)/; | |
# | |
# # my ($a1:D, $b1:D) = "".split()[3,4]; | |
# my ($a1:D); | |
# sub find-gcd (*@nums where (@nums.all ~~ Numeric or fail(‚I don't know how to find a gcd for a non-number.‘))) { | |
# [gcd] .min, .max with @nums | |
# } | |
# | |
# find-gcd(2,5,6,9,10).say; | |
# find-gcd(<1 2 3>).say; | |
# my $s = '(1+(2*3)+((8)/4))+1'; | |
# say [max] [\+] $s.comb.map({ $_ eq '(' ?? 1 !! $_ eq ')' ?? -1 !! Empty }); | |
# my @accounts = (1,2,3, 5,5,5, 3,1,4).rotor(3); | |
# say @accounts».sum.max; | |
# sub random-life-init(Int $factor){ | |
# my @shape = (1,2) »*» $factor; | |
# my @field[||@shape]; | |
# # @field = (Bool.pick.Int xx *).rotor(@shape[1]); | |
# (Bool.pick.Int xx @shape[0]).Array xx @shape[1]; | |
# } | |
# | |
# my @field = random-life-init(5); | |
# say @field; | |
# say @field.map(&left-shift); | |
# say @field.map(&right-shift); | |
# say @field.&rot90; | |
# | |
# say my @t1 = @field.map(&left-shift), @field, @field.map(&right-shift); | |
# | |
# sub left-shift(@a) { | |
# (|@a xx 3)[(+@a+1) .. (2 * +@a)].Array | |
# } | |
# | |
# sub right-shift(@a) { | |
# (|@a xx 3)[(+@a-1) .. (2 * +@a - 2)].Array | |
# } | |
# | |
# sub rot90(@a) { | |
# my @new; | |
# | |
# for ^+@a[0] -> $col is raw { | |
# my @row; | |
# for ^+@a -> $row is raw { | |
# @row.push(@a[$row][$col]) | |
# } | |
# @new.push: @row.reverse.Array; | |
# } | |
# | |
# @new; | |
# } | |
# | |
# # sub foo { "Good &:greeting(now.DateTime.hour) $:name!" }; | |
# # say foo :name<Paul>, :greeting{$_ < 12 ?? 'morning' !! 'day'}; | |
# # say &foo.signature; | |
# | |
# constant dice = ('DIE FACE-' «~« (1..6))».uniparse.cache; | |
# | |
# my $o = Metamodel::ClassHOW.new_type(:name<UnMu>); | |
# $o.HOW.add_fallback($o, -> | { True }, -> $o, $name { say $name; my method foo (|) { dice.roll } }); | |
# # $o.^compose; | |
# # $o := Mu.^can('CREATE')[0]($o); | |
# | |
# $o.foo; | |
# | |
# dd $o; | |
# | |
# multi sub infix:<in>(\needle, List \l) { l.first(needle) ?? True !! False } | |
# multi sub infix:<in>(\needle, Iterable \l) { l.list.first(needle) ?? True !! False } | |
# multi sub infix:<in>(\needle, Str \s) { s.contains(needle) ?? True !! False } | |
# | |
# say 'foo' in 'foobar'; | |
# say 'foo' in 'barbuzz'; | |
# say '1' in <1 2 3>; | |
# say '1' in <0 2 3>; | |
# | |
# my @a = <1 2 3 4>; | |
# my &f = * - 1; | |
# say @a[&f]; | |
# &f.WHAT.say; | |
# my ($f, $i is default(42)) = (1, Nil); say $i; | |
# | |
# my ($k, $j is default(42)) = (1); | |
# say $j; | |
# | |
# my %h1 = female => {died => 127, survived => 339}, male => {died => 682, survived => 161}; | |
# # my %h2 = died => { female => %h1<female><died>, male => %h1<male><died> }, survived => { female => %h1<female><survived>, male => %h1<male><survived> }; | |
# | |
# my %h2; | |
# for (%h1{*;*}:kv).flat.rotor(3)».[1,0,2] -> [ $k1, $k2, $v ] { | |
# %h2{||[$k1, $k2]} = $v; | |
# } | |
# | |
# say %h2; | |
# Nil.^methods.grep(*.name eq 'FALLBACK').say; | |
# | |
# say "+\c[COMBINING RING ABOVE]"; | |
# multi sub prefix:«+\c[COMBINING RING ABOVE]»(\r) { r.defined ?? +r !! 0 }; say +̊(0, 0, 0).first: +̊*, :k; | |
# | |
# my $message = '<Anton Antonov#7232> <@!210313526928080896> Ok, using my own fold/reduce definition is good. Thanks!'; | |
# | |
# my $t = [[1,2,3],[2,3,4]]; | |
# | |
# sub has-homogenus-shape(\l) { | |
# so l[*].&{ $_».elems.all == .[0] } | |
# } | |
# | |
# my $t1 = [[1,2,3],[2,3,4]]; | |
# my $t2 = [[1,2,3],[2,3]]; | |
# | |
# say $t1.&has-homogenus-shape; | |
# say $t2.&has-homogenus-shape; | |
# | |
# my $t3 = [ | |
# [[1,2,3],[2,3,4]], | |
# [[1,2,3],[2,3,4]] | |
# ]; | |
# | |
# say $t3[*;*;1]; | |
# my $num = 5; | |
# say (1..$num) Z** (1..$num); | |
# say (1..5)».&{ $^a ** $^a }; | |
# | |
# multi sub dezip(Range $r) { | |
# my ($left, $right) = Seq, Seq; | |
# $left := $r.min, $r.min.succ.succ … $r.max.pred; | |
# $right := $r.min.succ, $r.min.succ.succ.succ … $r.max; | |
# | |
# $left, $right | |
# } | |
# | |
# say (0..0x10FFFF).&dezip; | |
# | |
# (my $oddject = Metamodel::ClassHOW.new_type(name => "")).&{.^add_method('FALLBACK', method ($name) { 'cheating' }); .^compose}; | |
# | |
# dd $oddject; | |
# say $oddject.foo; | |
# | |
# constant term:<$container> = 1,2,3; | |
# | |
# say $container, $container.WHAT; | |
# say "answer: $container"; | |
# dd $container; | |
# | |
# sub s($first, *@rest){ | |
# dd $first, @rest; | |
# } | |
# | |
# s($container); | |
# { | |
# my @a = ("apple", " banana", " peach", "blueberry", "pear", " plum", "kiwi"); | |
# | |
# multi sub merge-spacy([]) { () } | |
# multi sub merge-spacy([$x is copy, *@xs]) { | |
# if @xs[0].?starts-with(' ') { | |
# $x ~= @xs.shift; | |
# merge-spacy([|$x, |@xs]) | |
# } else { | |
# $x, |merge-spacy(@xs) | |
# } | |
# } | |
# | |
# say 'functional'; | |
# dd merge-spacy(@a); | |
# } | |
# | |
# { | |
# my @a = ("apple", " banana", " peach", "blueberry", "pear", " plum", "kiwi"); | |
# | |
# sub merge-with(@a, &c) { | |
# gather while @a.shift -> $e { | |
# if @a && &c(@a.head) { | |
# @a.unshift($e ~ @a.shift) | |
# } else { | |
# take $e; | |
# } | |
# } | |
# } | |
# | |
# say 'gather/take'; | |
# dd @a.&merge-with(*.starts-with(' ')); | |
# } | |
# | |
# { | |
# my @a = ("apple", " banana", " peach", "blueberry", "pear", " plum", "kiwi"); | |
# | |
# multi sub join(*@a, :&if!) { | |
# class :: does Iterable { | |
# method iterator { | |
# class :: does Iterator { | |
# has @.a; | |
# has &.if; | |
# method pull-one { | |
# return IterationEnd unless @!a; | |
# | |
# my $e = @!a.shift; | |
# return $e unless @!a; | |
# | |
# while &.if.(@!a.head) { | |
# $e ~= @!a.shift; | |
# } | |
# | |
# return $e; | |
# } | |
# }.new(a => @a, if => &if) | |
# } | |
# }.new | |
# } | |
# | |
# .say for join(@a, if => *.starts-with(' ')); | |
# } | |
# | |
# { | |
# my @a = ("apple", " banana", " peach", "blueberry", "pear", " plum", "kiwi"); | |
# | |
# # &c decides if the group is finished | |
# sub group-list(@a, &c) { | |
# my @group; | |
# gather while @a { | |
# my $e = @a.shift; | |
# my $next := +@a ?? @a.head !! Nil; | |
# @group.push($e); | |
# if !c($e, $next) { | |
# take @group.clone; | |
# @group = (); | |
# } | |
# } | |
# } | |
# | |
# dd @a.&group-list(-> $left, $right { $right && $right.starts-with(' ')}); | |
# } | |
# { | |
# say '123456712' ~~ / $<ref> = [ . ** 2 ] .+ $<ref> /; | |
# } | |
# { | |
# my $s = 'a😅'; | |
# say $s.subst(/<:Emoji>/, '', :g); | |
# } | |
# | |
# { | |
# sub infix:«|,»(\a, \e) { | |
# Proxy.new(FETCH => method { |a, |e }, | |
# STORE => method (\e) {}) | |
# but role { method sink { a.push: e } }; | |
# } | |
# | |
# my @a = 1,2,3; | |
# @a |, 4; | |
# dd @a; | |
# my @b = @a |, 5; | |
# dd @a, @b; | |
# } | |
# { | |
# my $a = 42; say $a.not-there(); CATCH { when X::Method::NotFound { .resume } } | |
# } | |
# multi sub infix:«|,»(\left, \right) is equiv(&infix:<Z>) { |left, |right } | |
# multi sub infix:«|xx»(Mu \left, Mu \right) is equiv(&infix:<xx>) { (left xx right).flat } | |
# | |
# multi sub smart-join(&separators, *@l --> Str:D) { | |
# my $ret; | |
# | |
# while @l { | |
# $ret ~= @l.shift; | |
# $ret ~= separators if +@l; | |
# } | |
# | |
# $ret | |
# } | |
# | |
# multi sub smart-join(Seq:D \separator, *@l --> Str:D) { | |
# my $ret; | |
# my $sep-it = separator.iterator; | |
# my $list-it = @l.iterator; | |
# | |
# loop { | |
# my $e := $list-it.pull-one; | |
# last if $e =:= IterationEnd; | |
# | |
# $ret ~= $e; | |
# $ret ~= $sep-it.pull-one if $list-it.bool-only; | |
# } | |
# | |
# $ret | |
# } | |
# | |
# sub alternator(Mu \a, Mu \b) { | |
# $++ %% 2 ?? a !! b | |
# } | |
# | |
# dd smart-join(&alternator.assuming(|<: ;>), <a b c d e f>); | |
# 1900..2100 | |
# ==> grep({ Date.new(.Int, 1, 1).day-of-week | Date.new(.Int, 12, 31).day-of-week == 4 }) | |
# # ==> smart-join({ ++$ %% 8 ?? $?NL !! ' '}) | |
# ==> smart-join( (' ' xx 7 |, $?NL) |xx ∞ ) | |
# ==> say(); | |
# | |
# put (1900..2100).grep({ Date.new(.Int, 1, 1).day-of-week | Date.new(.Int, 12, 31).day-of-week == 4 }); | |
# | |
# put ( (1900..2100).grep({ Date.new(.Int, 1, 1).day-of-week | Date.new(.Int, 12, 31).day-of-week == 4 }) Z (' ' xx 7 |, $?NL) |xx ∞ ).flat.head(*-1).join(''); | |
# | |
# multi sub smart-split(Str $s, &needle) { | |
# my @ret; | |
# my $str-it = $s.comb.iterator; | |
# my $section = Empty; | |
# | |
# loop { | |
# my $e := $str-it.pull-one; | |
# last if $e =:= IterationEnd; | |
# | |
# dd $e; | |
# | |
# if needle($e) { | |
# @ret.push: $section; | |
# $section = ''; | |
# } else { | |
# $section ~= $e; | |
# } | |
# } | |
# | |
# @ret | |
# } | |
# | |
# 'a0b1c0d'.&smart-split({ .Numeric ~~ Numeric }).say; | |
# | |
# my %h1 = a => 2, b => 4, c => 0.1; | |
# my %h2 = :4a, :6b, :1c; | |
# | |
# say %h1 »+« %h2; | |
# { | |
# my $s = Empty; dd $s; say $s.defined; say ().defined; say "".defined; say Empty.defined; | |
# my $a = 1; my $b; say $a + $b; | |
# } | |
# { | |
# my $year = 2021; | |
# my Int() $samoa-correction = $year == 2011 && slurp('/etc/timezone').match(/ 'Pacific/Apia' /).so; | |
# say (Date.new(:$year) .. Date.new($year + 1, 1, 1).earlier(:1day)).grep({ .day-of-week !== 6|7}).elems - $samoa-correction; | |
# } | |
# | |
# { | |
# my &me = method ($o: $p) { dd $o, $p }; | |
# my &bound = &me.assuming(42); | |
# bound('I ♥ Raku‼'); | |
# } | |
# | |
# { | |
# (my $oddject = Metamodel::ClassHOW.new_type(name => "")).&{.^add_method('$methodd', method () { 'LOLWUT‽' }); .^compose}; | |
# | |
# say $oddject."\$methodd"(); | |
# | |
# } | |
# { | |
# while my Str:D $input = prompt 'Please be so kind to enter an integer: ' { | |
# last if $input ~~ / ^^ '-'? \d+ $$ /; | |
# } | |
# | |
# } | |
# { | |
# say <a b c>.map({ |($_, $_.uc) }).join('|'); | |
# } | |
# { | |
# role QuotedStr { | |
# method new() is rw { | |
# my $theStr = ""; | |
# Proxy.new( | |
# STORE => method (Str() $new is raw) { $theStr = $new.subst(/ [ ^ || <-[\\]> ] '"' /, '\"', :g) }, | |
# FETCH => method () { $theStr but QuotedStr } | |
# ) | |
# } | |
# } | |
# | |
# my $qs := QuotedStr.new; | |
# $qs = "abc"; dd $qs; | |
# $qs = 12; dd $qs; | |
# $qs = '"ABC"'; say $qs; | |
# | |
# sub testy(QuotedStr $s is raw) is rw { | |
# say $s ~~ QuotedStr; | |
# | |
# $s | |
# } | |
# | |
# sub changy(QuotedStr $s is raw ) is rw { | |
# $s = $s ~ '-changed'; | |
# } | |
# | |
# dd $qs.&testy.&changy; | |
# } | |
# { | |
# multi sub postfix:<minute>(Numeric() \seconds) { seconds * 60 } | |
# multi sub postfix:<minutes>(Numeric() \seconds) { seconds * 60 } | |
# multi sub postfix:<hour>(Numeric() \seconds) { seconds * 3600 } | |
# multi sub postfix:<hours>(Numeric() \seconds) { seconds * 3600 } | |
# multi sub postfix:<day>(Numeric() \seconds) { seconds * 86400 } | |
# multi sub postfix:<days>(Numeric() \seconds) { seconds * 86400 } | |
# | |
# react whenever Supply.interval(5minutes) { | |
# note ‚taking snapshot‘; | |
# use Perl6::Compiler:from<NQP>; | |
# sub compress(Str() $file-name) { run «lz4 -BD --rm -qf $file-name» } | |
# | |
# my $filename = 'raku-bot-' ~ now.DateTime.&{ .yyyy-mm-dd ~ '-' ~ .hh-mm-ss } ~ '.mvmheap'; | |
# Perl6::Compiler.profiler-snapshot(kind => "heap", filename => $filename<>); | |
# # $filename.&compress or warn(‚compression failed‘); | |
# | |
# note ‚done‘; | |
# } | |
# } | |
# | |
# { | |
# for [2, 3, 4; 3, 3, 6; 200, 300, 40; 0, 0, 0] -> [$i, $j, $k] { | |
# put ((1..$i) X* (1..$j)).sort[$k - 1]; | |
# | |
# CATCH { when X::OutOfRange { warn „Sorry, I can't find position $k in the multiplication table of $i and $j.“ } } | |
# } | |
# } | |
# { | |
# class A { has %.f is Set[Str]; } | |
# say A.new.f.WHAT; | |
# } | |
# { | |
# my @a = (1,2,3,4) xx 4; | |
# cross(||@a).say; | |
# } | |
# { | |
# use Test; | |
# | |
# class A { has @.b }; | |
# my @b = 1,2,3; | |
# my %a = :@b; | |
# dd %a; | |
# | |
# is-deeply A.new(|Pair.new('b', @b)), A.new(:@b) | |
# } | |
# | |
# { | |
# put [Z~] (^10 X ^50).map(-> [$a, $b] { '.' ~ ($b == 49 ?? "\n" !! '') }); | |
# } | |
# { | |
# use Test; | |
# ok 1 ~~ TR/\#//, 'Backslashed # is parsed correctly in a regex'; | |
# is (TR/\#/a/ with '#'), 'a', 'transliteration of # works'; | |
# } | |
# { | |
# multi sub possible($a, $b where { $a == $b² }) { say „$a is $b²“ } | |
# multi sub possible($a, $b where { $a =~= $b²}) { say „$a is possibly $b²“ } | |
# multi sub possible(| ($a, $b)) { say „$a is not $b²“ } | |
# | |
# possible 1, -1; | |
# possible 2, sqrt(2); | |
# possible 4, 4; | |
# } | |
# { | |
# sub postfix:<?>(\p) { p } | |
# say my $hey-raku-what-kind-of-problems-can-i-solve-with-you?; | |
# } | |
# { | |
# sub rakudoconfuser(Str $) {}; | |
# my &clonish = &rakudoconfuser.clone; | |
# &rakudoconfuser.wrap: sub (Int $) {}; | |
# my &alias = &rakudoconfuser; | |
# alias(42); | |
# clonish("answer"); | |
# | |
# sub wrap-pure(&s, &wrapper) { | |
# my &ret = &s.clone; | |
# my $handle = &ret.wrap(&wrapper); | |
# &ret but class :: { has $.wrap-handle }.new(:wrap-handle($handle)) | |
# } | |
# | |
# sub subby(Str $) {} | |
# my &tubby = wrap-pure &subby, sub (Int $i) { callwith $i.Str }; | |
# tubby(42); | |
# subby(‚answer‘); | |
# | |
# | |
# multi sub trait_mod:<is>(Sub $s, :$looping){ | |
# $s.wrap: sub (*@a) { callwith($_) for @a } | |
# } | |
# | |
# sub forgotname(Str() $s) is looping { | |
# say $s; | |
# } | |
# | |
# ::("&forgotname").(1,2,3); | |
# } | |
# my @a = 1..10; | |
# | |
# sub divide(&condition, *@a) { | |
# my (@r-a, @r-b); | |
# | |
# .&condition ?? @r-a.push($_) !! @r-b.push($_) for @a; | |
# | |
# @r-a, @r-b | |
# } | |
# | |
# use MONKEY-TYPING; | |
# augment class List { | |
# method divide(&condition) { | |
# my (@r-a, @r-b); | |
# | |
# .&condition ?? @r-a.push($_) !! @r-b.push($_) for self; | |
# | |
# @r-a, @r-b | |
# } | |
# } | |
# | |
# List.^compose; | |
# | |
# my (@b, @c) := divide * %% 2, @a; | |
# dd @b, @c; | |
# | |
# my (@e, @f); | |
# | |
# @a ==> divide({ Bool.pick }) | |
# ==> say(); | |
# | |
# # dd @e, @f; | |
# | |
# say @a.divide({Bool.pick}); | |
# | |
# sub divide2(&conditional, *@a) { | |
# my $arity = &conditional.arity; | |
# my @ret; | |
# if &conditional.arity == 0 { | |
# for @a { | |
# @ret[conditional].push: $_ | |
# } | |
# } elsif $arity == 1 { | |
# my @ret; | |
# for @a { | |
# @ret[.&conditional].push: $_ | |
# } | |
# } else { | |
# my @streams = @a.rotor($arity); | |
# for @streams { | |
# my $order = conditional(|$_); | |
# dd $_, $order; | |
# @ret.push: $_[$order] | |
# } | |
# } | |
# @ret; | |
# } | |
# | |
# say divide2({Bool.roll}, 1..10); | |
# say divide2({$^a %% 2}, 1..10); | |
# say divide2({(0..2).roll}, 1..10); | |
# say divide2(sub { Bool.roll }, 1..10); | |
# say divide2({ $^a > $^b }, (1..10).pick(*)); | |
# { | |
# (^∞).hyper.grep({$_ !%% 2 && .is-prime})[^100000].sum.say; | |
# say now - ENTER now; | |
# } | |
# { | |
# (^∞).hyper(:batch(5000)).grep({$_ !%% 2 && .is-prime})[^100000].sum.say; | |
# say now - ENTER now; | |
# } | |
# { | |
# sub hyper(+@a, *%_) { @a.hyper(|%_) } | |
# sub tail(+@a, *%_) { @a.tail(|%_) } | |
# | |
# sub is-palindrom(\v) { v eq v.flip } | |
# sub is-boring(\s) { my \c = s.comb; c[0] eq c.all } | |
# my @primes = ^10_000 .grep(*.is-prime); | |
# (@primes X @primes) | |
# ==> hyper(:batch(1000)) | |
# ==> grep({ (.[0] * .[1]).&{ .&is-palindrom & .&is-boring } }) | |
# ==> map({ [ .[0,1], .[0] * .[1] ] }) | |
# ==> unique(:as(*[1])) | |
# ==> sort(*[1] <=> *[1]) | |
# ==> tail(20) | |
# ==> map({ .[0;0] ~ ' * ' ~ .[0;1] ~ ' = ' ~ .[1] }) | |
# ==> join($?NL) | |
# ==> put(); | |
# | |
# # .flat.say for (@primes X @primes).hyper(:batch(1000)).grep({ my \p = .[0] * .[1]; p.&is-palindrom & p.&is-boring }).map({ [.[0,1], .[0] * .[1] ] }).unique(:as(*[1])).sort(*[1] <=> *[1]).tail(20); | |
# say now - ENTER now; | |
# | |
# my @a = hyper for ^100_000 { .is-prime }; | |
# say @a; | |
# } | |
# { | |
# | |
# sub chain(&op where *.count == 2, \listy where *.^can('rotor')) { | |
# for listy.rotor(2=>-1) -> [\a, \b] { | |
# return False unless op(a, b) | |
# } | |
# | |
# True | |
# } | |
# | |
# my $res; | |
# ($res += chain(&[eq], <1 2 1 1 1 1 1 1 1>)) for ^100000; | |
# say [$res, now - ENTER now]; | |
# } | |
# { | |
# my $res; | |
# | |
# ($res += ('1' eq <1 2 1 1 1 1 1 1 1>.all).Bool) for ^100000; | |
# say [$res, now - ENTER now]; | |
# | |
# } | |
# { | |
# sub frontend(|c ($arg1, $arg2, $arg3?)) { | |
# my \d = \(|c[0,1], c[2] // 42); | |
# backend(|d); | |
# } | |
# sub backend($arg1, $arg2, $arg3) { | |
# say $arg1, $arg2, $arg3 | |
# } | |
# frontend(1,2); | |
# } | |
# { | |
# dd do if 0 {}; | |
# dd (42 if 0); | |
# dd do with Any {}; | |
# dd (42 with Any); | |
# } | |
# { | |
# dd (1..10).grep(* %% 2).map(* * 10).head(2); | |
# | |
# class Generator does Iterable { | |
# has $.code; | |
# has $.input; | |
# method iterator { | |
# class :: does Iterator { | |
# has $.code; | |
# has $.input; | |
# method pull-one { | |
# loop { | |
# my \value = $.input.pull-one; | |
# next if value =:= Empty; | |
# return $.code.(value); | |
# } | |
# } | |
# }.new(:code(self.code), :input(self.input)) | |
# } | |
# } | |
# | |
# my $range := (1..10); | |
# my $grep := Generator.new(:code({$_ %% 2 ?? $_ !! Empty}), :input($range.iterator)); | |
# my $map := Generator.new(:code({$_ * 10}), :input($grep.iterator)); | |
# my $head := Generator.new(:code({ $++ ≥ 2 ?? IterationEnd !! $_}), :input($map.iterator)); | |
# | |
# .say for $head; | |
# | |
# # while (my \e = it.pull-one) !=:= IterationEnd { | |
# # | |
# # } | |
# } | |
# { | |
# my @a = <Alice Bob Charly Peter Paul Marry>; | |
# | |
# sub dissolution(+@a) { | |
# @a.pick(*).&{ .[] Z .[1..*,0].flat } | |
# } | |
# | |
# say @a.&dissolution; | |
# } | |
# { | |
# my \primes = (^∞).hyper.grep(*.is-prime); | |
# say primes ~~ Positional; | |
# } | |
# | |
# { | |
# augment class Any { | |
# class OmniHyper is Mu { | |
# has $.former-self; | |
# method FALLBACK($name, |c) { | |
# dd $name; | |
# $.former-self."$name"(|c) | |
# } | |
# } | |
# multi method omni( --> OmniHyper:D) { | |
# OmniHyper.new(:former-self(self)) | |
# } | |
# } | |
# | |
# dd 42.omni.tail; | |
# } | |
# { | |
# class Exfiltrator is Nil { | |
# method new { self.CREATE } | |
# has $.payload is rw; | |
# } | |
# | |
# sub subish( --> Int:D) { | |
# Exfiltrator.new.&{ .payload = "important document"; $_ } | |
# } | |
# | |
# say subish.WHAT; | |
# say subish.payload; | |
# } | |
{ | |
# # sub sc($_) { | |
# # # my \c = (|(&lc, &uc) xx *).cache; | |
# # # .words».&{ (.comb Z c.clone).map( -> ($c, &c) { c($c) }).join }.flat; | |
# # # my @c = (|(&lc, &uc) xx *); | |
# # # .words».&{ my @a = @c; .comb.map({ @a.shift.($_) }).join }.flat | |
# # .words».&{ (.comb »,» (&lc, &uc)).flat.map({ &^b($^a) }).join }.flat | |
# # } | |
# # sub sc($_) { | |
# # .words».&{ (.comb »,» (&lc, &uc)).flat.map({ &^b($^a) }).join }.flat | |
# # } | |
# multi sub infix:<⊙>(&c, +@a) { | |
# &c.assuming(|@a) | |
# } | |
# sub sc($_) { | |
# .words».&{ ((&lc, &uc) «⊙« .comb)».().join } | |
# } | |
# for ^1 { | |
# say sc "sarcasmcase FOR YOU"; | |
# } | |
# say now - ENTER now; | |
} | |
# { | |
# multi sub hyperize(&code, '«') { | |
# sub (@little, @large) { | |
# ((@little xx *).flat Z @large).flat.map(&code)a | |
# } | |
# } | |
# | |
# my &hyper-assume = hyperize({&^a.assuming($^b)}, '«'); | |
# | |
# sub sc($_) { | |
# .words».&{ hyper-assume((&lc, &uc), .comb)».().join } | |
# } | |
# for ^1 { | |
# say sc "sarcasmcase FOR YOU"; | |
# } | |
# say now - ENTER now; | |
# } | |
# { | |
# my @arr = ["real", 12, -5, 77, 61, "diff", 40, 0, "wrong", 88, 8, -51]; | |
# my %h = @arr.reverse.map: { | |
# state @stack; | |
# | |
# when Numeric { @stack.push($_); Empty } | |
# when Str { LEAVE @stack = (); $_ => @stack.reverse.Array } | |
# }; | |
# | |
# dd %h; | |
# } | |
# { | |
# my @arr = ["real", 12, -5, 77, 61, "diff", 40, 0, "wrong", 88, 8, -51]; | |
# my %h = gather for @arr.reverse { | |
# our @stack; | |
# when Numeric { @stack.push($_); } | |
# when Str { take .Str => @stack.reverse; @stack = () } | |
# } | |
# | |
# dd %h; | |
# } | |
# { | |
# my @arr = ["real", 12, -5, 77, 61, "diff", 40, 0, "wrong", 88, 8, -51]; | |
# my %h = @arr.categorize: {state $cat = Nil; when Str { $cat = .Str; Empty }; $cat }; | |
# dd %h; | |
# } | |
# { | |
# my \hyperish = ["real", 12, -5, 77, 61, "diff", 40, 0, "wrong", 88, 8, -51].hyper; | |
# | |
# sub hashify(Sequence \seq) { | |
# my $it = seq.iterator; | |
# my Mu $value := $it.pull-one; | |
# do loop { | |
# sub shift { | |
# LEAVE $value := $it.pull-one; | |
# $value; | |
# } | |
# | |
# last if $value =:= IterationEnd; | |
# | |
# shift() => [ shift() while $value ~~ Numeric ] | |
# } | |
# } | |
# | |
# say hashify(hyperish); | |
# } | |
# { | |
# sub subby($_) { m/abc/ } | |
# my $subby := &subby; | |
# say 'abc' ~~ $subby; | |
# | |
# ;&say.("copper {25-9+12+12+18+18+12}") | |
# } | |
# { | |
# constant &s = (now.DateTime.day-of-week == 7) ?? sub () {} !! sub (|) {}; | |
# constant c = s(42); | |
# } | |
# { | |
# sub MAIN() { | |
# my \leftfact = [\+] 0, 1, * * ++$ … ∞; | |
# say leftfact[1..10]; | |
# } | |
# } | |
# { | |
# | |
# my \fact = 1, * * ++$ … ∞; | |
# fact[0..10]; | |
# .say for (^∞).hyper(:batch(1000)).grep({ fact[.comb].sum == .Int }); | |
# | |
# sub MAIN(Int() $n) { | |
# my \fact = 1, * * ++$ … ∞; | |
# say fact[$n.comb].sum == $n ?? 1 !! 0 | |
# } | |
# } | |
# { | |
# sub infix:<␣>(\l, \r) is equiv(&infix:<,>) { l ~ ' ' ~ r } | |
# | |
# my $woman = 145_805_947 / 2; | |
# my $girls-per-woman := 0.91; | |
# | |
# # for 2022, 2022+35 … ∞ -> $year { | |
# # say ($year+35) ␣ (($woman *= $girls-per-woman)*2).fmt('%.1f'); | |
# # sleep 0.25; | |
# # } | |
# | |
# role Degression { } | |
# my \degression = (2022, $woman), -> [$y, $w] { ($y + 35, $w * $girls-per-woman) but Degression } … ∞; | |
# multi sub pretty(Degression [$year, $woman]) { | |
# "year: $year, Russians in RU: {($woman * 2).fmt('%.1f')}" | |
# } | |
# | |
# say degression[1000/35].&pretty; | |
# say "Soldiers available in {(1000/35).Int} generations: {Int(degression[1000/35][1]/$woman * 140000)}"; | |
# } | |
# { | |
# sub s1(+lol) { dd lol } | |
# my @a := <l 2 3>,<a b c>; | |
# s1(@a); | |
# say &infix:<Z>.(@a.Slip); | |
# say Seq.new(Rakudo::Iterator.ZipIterablesOp(@a, &infix:<Z>)); | |
# } | |
# { | |
# my &s1 = sub { state $i; say $i++ }; | |
# s1; | |
# s1; | |
# &s1.wrap(sub { nextsame }); | |
# s1; | |
# } | |
# { | |
# say ((1, * × ++$ … ∞)[1234] ~~ /\d+? ('0'+) $/).[0].chars; | |
# } | |
# { | |
# my $r = 42|0|Inf; say $r == NaN; | |
# my $a; $a = do given "NaN" { when NaN { "nan" }; default { "default" } }; say $a; | |
# $a = "NaN"; | |
# say NaN.ACCEPTS('NaN'); | |
# } | |
# { | |
# multi sub manna(Int:D $i) { 'Int' } | |
# multi sub manna(Str:D $s) { 'Str' } | |
# multi sub manna(@a) { gather for @a { take .&manna } } | |
# multi sub manna(|) { fail 'manna called with anything but Int|Str' } | |
# | |
# my @lots = (42, 'answer').roll(*); | |
# | |
# say @lots.is-lazy; | |
# say @lots.&manna[^10]; | |
# | |
# my @wrongish = (Int, 'wrong').roll(*); | |
# | |
# say @wrongish.&manna[^10]; | |
# } | |
# { | |
# | |
# class Node { | |
# has Node $.parent; | |
# has Node $.next; | |
# has $.payload; | |
# | |
# method !parent { return-rw $!parent } | |
# method !next { return-rw $!next } | |
# | |
# multi method walk(&code) { | |
# my $it = self; | |
# loop { | |
# last without $it; | |
# code($it.payload); | |
# $it = $it!Node::next; | |
# } | |
# } | |
# method add(Node:D $new-node) { | |
# my $last = self; | |
# while $last!next { | |
# $last = $last!next; | |
# } | |
# | |
# $last!next = $new-node; | |
# $new-node!Node::parent = $last; | |
# self | |
# } | |
# method list() { | |
# my $it = self; | |
# gather while $it { | |
# take $it.payload; | |
# $it = $it!Node::next; | |
# } | |
# } | |
# method map(&code) { self.list.map(&code) } | |
# } | |
# | |
# my $root = Node.new(:payload(1)); | |
# $root.add(Node.new(:payload(2))); | |
# $root.add(Node.new(:payload(3))); | |
# my @a = do for $root { $_ }; | |
# dd @a; | |
# $root».&say; | |
# } | |
# { | |
# class Base {} | |
# class SubClass is Base {} | |
# | |
# multi sub trait_mod:<of>(\type, Base $base, |c) { dd type; dd c } | |
# subset Better of SubClass where { put "where: $_"; True }; | |
# | |
# my Better $a = 42; | |
# | |
# subset Universe of Base where { die 'wrong answer' unless $_ == 42; True } | |
# my Universe $b = 42; | |
# | |
# } | |
# { | |
# my $a = 'ABcd'; | |
# $a .= lc | |
# .uc; | |
# say $a; | |
# $a = 'ABcd'; | |
# $a .= lc .= uc; | |
# say $a; | |
# } | |
# { | |
# say qq{{ {$a} }}; | |
# } | |
# | |
# { | |
# my @texts = 'One should love peace.', 'One should break peace.', 'One should hate peace.'; | |
# my @unaccaptable-behaviour = <break hate>; | |
# say @texts.grep(/ [ @unaccaptable-behaviour && <!> || 'love' ] \s peace /); | |
# } | |
# { | |
# sub term:<😃> { 'Wooohooo‼' } | |
# say 😃; | |
# } | |
# { | |
# say ‚Raku Raku respects Perl's ways too too (to an an extend)‘.words.rotor(2 => -1)\ | |
# .pairs.grep({ .value[0] eq .value[1] })».keys.flat\ | |
# .map({ constant suffix = (flat <st nd rd>, 'th' xx *); $_+1 ~ suffix[$_] }) | |
# .join(', ') ~ ' words are repeated'; | |
# constant @suffix = flat(<st nd rd>, 'th' xx *).lazy; | |
# .say for ((1..∞) Z~ @suffix)[^10]; | |
# } | |
# { | |
# constant l1 = 1, 2 … ∞; | |
# constant l2 = 1, 2 … ∞; | |
# constant concat_l1_l2 = flat(l1, l2).lazy; | |
# say concat_l1_l2; | |
# } | |
# { | |
# proto sub deepantipairs(@positional, $dimensions --> Positional) {*} | |
# multi sub deepantipairs(@a, 2) { | |
# @a.pairs.map({ my $outer-key = .key; .value.antipairs.map({ .key => ($outer-key, .value) }) }).flat | |
# } | |
# my $phrase = 'Spring has sprung!'; | |
# my @table = flat($phrase.lc.comb.grep(/\w/), 'a'..'z').unique[^25].batch(5); | |
# my %antitable = @table.&deepantipairs(2); | |
# | |
# sub encrypt($phrase, $text --> Str) { | |
# my @table = flat($phrase.lc.comb.grep(/\w/), 'a'..'z').unique[^25].batch(5); | |
# my %antitable = @table.&deepantipairs(2); | |
# | |
# my $retval; | |
# | |
# for $text.lc.comb.grep(/\w/) -> $char { | |
# my @deepindex := %antitable{$char}; | |
# $retval ~= @table[||@deepindex]; | |
# @table = @table».List.flat[1..*,0].flat.batch(5); | |
# } | |
# | |
# $retval | |
# } | |
# | |
# say encrypt($phrase, 'As suspicious questions on IRC and Discord revealed, there are quite a few solutions to the PWC that are not made public. One question in particular indicates that there is a build-in in Raku missing.'); | |
# | |
# } | |
# { | |
# enum Unit (<m m1 m2> Z=> <m m1 m2>); my $str = 'm1'; say $str ~~ Unit(); sub foo(Unit() $u) { say $u }; foo('m2'); | |
# dd Unit().HOW; | |
# } | |
# { | |
# my \hs = (10**1000..∞).hyper.grep(*.is-prime); | |
# | |
# sub foo(@whatever --> Seq) { | |
# for @whatever -> $n1, $n2, $n3 { | |
# say $n1 + $n2 + $n3 | |
# } | |
# } | |
# | |
# my @many = foo(hs); | |
# } | |
# { | |
# | |
# my %h = flat <a b c> »,» 42; | |
# dd %h; | |
# } | |
# { | |
# multi sub forrest(&c, []) { Empty } | |
# multi sub forrest(&c, [$a, *@rest]) { | |
# c($a, @rest); | |
# forrest(&c, @rest); | |
# } | |
# my @values = <av r ew t i h>; | |
# my @foo = forrest { say $^a.lc, @^b».uc.join }, @values; | |
# } | |
# { | |
# my @a of Int; dd @a; sub foo(Int @a) { dd @a; } | |
# my @b of Int(); | |
# dd @b; | |
# constant term:<@c> = my @ = Array[Int](); @c = 1,2,3; dd @c; | |
# } | |
# { | |
# use export-term; | |
# | |
# say export-term::.keys; | |
# | |
# say export-term::<term:<2pi>>; | |
# # 2pi; | |
# } | |
# { | |
# multi sub infix:<M>(\l, \r) { l.tail eqv r ?? l !! slip(l,r) }; | |
# multi sub infix:<M>(\l, Nil) { say 'Nil'; l }; | |
# my @a = <a a b c c d e e e>; | |
# | |
# my \foo = lazy gather for @a -> $l, $r? = Nil { take $l M $r }; | |
# dd [M] <a a b c c d e e e>; | |
# } | |
# { | |
# use Log; | |
# | |
# dd ERROR('foo') ~~ LogLevel::ERROR; | |
# dd ERROR('foo') ~~ LogLevel::DEBUG; | |
# say ERROR('foo').&{ .file, .line }; | |
# ERROR 'foo'; | |
# VERBOSE 'Detailed, very much so indeed.'; | |
# my $*LOGLEVEL = 2; | |
# VERBOSE 'Detailed, very much so indeed.'; | |
# } | |
# { | |
# class Foo { method STORE(Int $x) { $x.say } }; | |
# Foo = 42; | |
# constant term:<$container> = class :: { method STORE(|c) { dd c } }.new; | |
# $container = 42; | |
# } | |
# { | |
# class C { | |
# method sink { dd 'sunk', $*dyn // 0; } | |
# method test { dd $*dyn; } | |
# } | |
# | |
# | |
# my $*dyn; | |
# my $c = C.new; | |
# $*dyn = 42; | |
# $c.test; | |
# sub foo { $c } | |
# foo; | |
# } | |
# { | |
# say "".so; | |
# my $a = 42; | |
# if True { &?BLOCK.signature.say } | |
# if $a { ++$a } | |
# dd $a; | |
# | |
# constant term:<$variable> = 'UK'; | |
# say "The $variable is run by a clown."; | |
# constant term:<$constant> = $; | |
# $constant = 'USA'; | |
# say "The $constant *was* run by a clown."; | |
# | |
# sub foo($var) { } | |
# my $var = IterationEnd; | |
# foo($var); | |
# | |
# } | |
# { | |
# multi sub foo($a, $? where ($*MODE // '') eq 'debug') { say "$a with debug"; }; my $*MODE = 'debug'; foo(42); | |
# } | |
# { | |
# sub MAIN(Int() $sides, Int() :$rounds = 10_000_000, Int() :$advantage = 1) { | |
# my \sides := 1..$sides; | |
# sub roll { [max] sides.roll xx $advantage } | |
# sub normalise($n) { $n / $rounds } | |
# | |
# my $sum; | |
# $sum += roll for ^$rounds; | |
# $sum .= &normalise; | |
# | |
# say $sum; | |
# } | |
# | |
# # await start { MAIN 20, :advantage(2) } for ^10; | |
# } | |
# { | |
# constant primes = (^∞).hyper.grep: *.is-prime; | |
# say primes[5,50,500,5000,50000]; | |
# say primes.WHAT; | |
# say primes.^can('AT-POS'); | |
# say &postcircumfix:<[ ]>.cando(\(primes, [1,2,3]))».&{.file ~ ':' ~ .line}; | |
# } | |
# { | |
# enum proc-options <one two three four>; | |
# my @opt = qw<one two three four five>; | |
# | |
# for @opt -> $opt { | |
# ::{$opt}:exists | |
# ?? say $opt | |
# !! warn("'$opt' is not a valid option"); | |
# } | |
# | |
# say ::.EXISTS-KEY('one'); | |
# say ::.WHAT; | |
# say ::.^methods(:local); | |
# | |
# # my @a = 1, 1, * + * … ∞; | |
# # say @a.WHAT; | |
# | |
# # multi sub foo(Int:D $i) { } | |
# # multi sub foo($i where { $i - $i.truncate == 0 }) { say 'lolwut‽' } | |
# # multi sub foo($) { say 'not integer'; } | |
# | |
# # foo(1.0); | |
# # foo(1/1); | |
# # foo(¼); | |
# | |
# # multi sub bar(Any:D $) { say 'defined'; } | |
# # multi sub bar(Any:U $) { say 'undefined'; } | |
# # | |
# # bar(Int); | |
# # | |
# # class C { method defined { False }; method DEFINITE { False } } | |
# # my $c = C.new; | |
# # bar(C); | |
# # bar($c); | |
# # say defined $c; | |
# # say $c."DEFINITE"(); | |
# # say $c // '// undefined'; | |
# # | |
# # say $c ~~ Mu:D; | |
# } | |
# { | |
# my $x = ^Inf; | |
# subset PositiveInteger of Numeric:D() where { $^i > 0 && ($i - $i.truncate == 0) || fail("Expected a positive and an integer value but got $i.")} | |
# sub get-prime($nth where * > 0) { | |
# say ($x.grep: *.is-prime)[$nth - 1]; | |
# } | |
# for (5, 50, 500, 5000, 50000) { get-prime $_ }; | |
# get-prime('5'); | |
# get-prime(½); | |
# | |
# my &b = * + *; | |
# say .WHAT, .signature with &b; | |
# my &b2 = { $^a + $^b }; | |
# say .WHAT, .signature with &b2; | |
# } | |
# { | |
# try { | |
# class :: { # I didn't came up with a good name, so I didn't gave one to this class. | |
# subset PositiveRat of Rat where * ≥ 0; | |
# | |
# has PositiveRat() $.balance = 0; # We could do the value check on exit of method withdraw with a trait. But this is bad practice. Just do it for the whole class. | |
# | |
# method withdraw(Int $amnt where { $amnt ≤ self.balance }) { | |
# self.balance -= $amnt; | |
# } | |
# }.new.withdraw(1); | |
# CATCH { default { .&warn } } | |
# } | |
# | |
# # So you want to test your tests? | |
# | |
# sub window1($n, *@a) { | |
# @a »*» $n # this is a hyperoperator of *, think: vector operations and more | |
# } | |
# | |
# sub window2($n, *@a) { | |
# @a.map(* * $n).Array | |
# } | |
# | |
# use Test; | |
# | |
# my @values = (2; 1, 2, 3, 4), (4; 1, 2, 3, 4); | |
# for @values -> @args { | |
# is-deeply window1(|@args), window2(|@args), „same for @args[]?“ # we like e-mail-adresses in our strings, so we demand a zen-slice for interpolating @-sigiled symbols | |
# } | |
# | |
# # Everything is not a graph. Larry is mad, not insane. | |
# | |
# # Sadly, we don't got factorials build in. So you may need to load a module for your calculator. | |
# | |
# # $ raku -Mcalculator # REPL with preloading a module | |
# | |
# # this goes into calculator.rakumod, and yes, we can define custom operatos with ease | |
# | |
# multi sub postfix:<!>(Int $n) { [*] 1..$n } | |
# multi sub postfix:<!>(@ns) { @ns.map: *! } | |
# | |
# # this goes into the REPL, you don't _have_ to type 'say' here | |
# | |
# say [*] (10,20,30)!; # [*] takes the infix operator * and turns it into a reduction meta-operator | |
# | |
# # you like Excel? Excellent! | |
# | |
# my $input = 1; | |
# my &out1 = { $input + 1 }; # raku is so functional that blocks are first-class citizen | |
# $input = 2; | |
# say out1; | |
# # out1.replace(+, -) is not possible right now. The compiler frontent is being rewritten right now, so we may be able to serve you next year with then new macro-system | |
# | |
# # you can have as many types as you want, whenever you want them | |
# | |
# my $type = Metamodel::ClassHOW.new_type(name => "NewType", ver => v0.0.1, auth => 'github:perl6' ); | |
# $type.HOW.add_method($type,"hey", method { say "Hey" }); | |
# $type.hey; # OUTPUT: «Hey» | |
# $type.HOW.compose($type); | |
# my $instance = $type.new; | |
# $instance.hey; # OUTPUT: «Hey» | |
# | |
# # you can capture a type of a parameter at runtime and do stuff with it | |
# | |
# sub foo(::T \s) { | |
# say „The type of s is {T.^name}.“; | |
# } | |
# foo 1/2; # The type of s is Rat. | |
# foo "42"; # The type of s is Str. | |
# | |
# # a container with a value constraint | |
# my $v where (10 < * < 50) = 42; | |
# try { | |
# # this fails when $v tries to cross 50; | |
# | |
# $v++ for ^10; | |
# CATCH { when X::TypeCheck::Assignment { say ‚$v foolishly tried to cross 50.‘ } } | |
# } | |
# } | |
# { | |
# | |
# my @a = <a b c d>; | |
# my $c = class C { | |
# our sub foo(*@a) { @a }; | |
# method foo(*@a) { @a } | |
# }.new; | |
# @a ==> $c::foo() ==> say(); | |
# @a ==> foo($c:) ==> say(); | |
# foo($c: @a); | |
# } | |
# { | |
# use experimental :macros; | |
# | |
# macro symbol-name($symbol) { | |
# quasi { $symbol.Str } | |
# } | |
# | |
# my $foo; | |
# say $foo.VAR.name; | |
# my $bar := $foo; | |
# say symbol-name($foo); | |
# say symbol-name($bar); | |
# constant $never-changes = 'war'; | |
# say $bar.VAR.name; | |
# # say $never-changes.VAR.name; | |
# say symbol-name($never-changes); | |
# } | |
# { | |
# react { | |
# whenever Supply.interval(0.01) { | |
# done if ++$ ≥ 5; | |
# | |
# once { say 'thinkging'; next } | |
# say 'still thinking'; | |
# } | |
# CLOSE { say 'done thinking'; } | |
# } | |
# } | |
# { | |
# None: Nil; | |
# | |
# subset Option of Any where Any:D | None; | |
# | |
# try { | |
# my Option $defined = 42; | |
# my Option $nothing = None; | |
# my Option $undefined = Mu; | |
# | |
# .&dd for $defined, $nothing, $undefined; | |
# | |
# CATCH { default { note .message; .resume } } | |
# } | |
# } | |
# { | |
# constant SVG = class :: does Associative { | |
# submethod AT-KEY($name) { sub (*%args) { "<$name " ~ %args.kv.map({ „$^a="$^b"“ }).join(' ') ~ "></$name>" } } | |
# }.new; | |
# | |
# say SVG<circle>(:x(10), :y(10), :r(50)); | |
# } | |
# { | |
# my $var := Proxy.new: STORE => method (|) { }, FETCH => method { ++$ > 5 ?? Mu !! 42 }; $var.say for ^5; | |
# } | |
# { | |
# sub { fail('bad') }() // say 'failed'; | |
# # Failure.new('bad') // say 'failed'; | |
# } | |
# { | |
# sub suspicious($a, :$b, *@rest, *%opts) { | |
# die('imaoutahere!'); | |
# | |
# CATCH { | |
# put (my $sig = &?ROUTINE.signature.gist) ~ ' -> ' ~ $sig.trans(<*@ *%> => <@ %>).EVAL».raku.join(','); | |
# } | |
# } | |
# | |
# suspicious(1, :2b, 3,4,5); | |
# } | |
# { | |
# say do for ^5 { | |
# last(42) if True; | |
# .say; | |
# | |
# CONTROL { when CX::Last { say .^name; .resume } } | |
# } | |
# (40,41,'answer',43) .map({ last(42) if .contains('answer'); say "It's not $_."; Empty }).say; | |
# | |
# class C { method map(|) { put ‚custom map‘ } } | |
# | |
# do for C.new { } | |
# } | |
# { | |
# class C { has $.exp; method m($a) { $a ** $!exp } } | |
# | |
# my $c = C.new(:exp(2)); | |
# m($c: 5).say; | |
# } | |
# { | |
# multi foo(Map $wanna) { | |
# say „got $wanna“; | |
# } | |
# | |
# multi foo(*@okish) { | |
# foo @okish.pairs.Map; | |
# } | |
# | |
# foo 1,2,3,4; | |
# } | |
# { | |
# role BatchedSeq { } | |
# | |
# sub dynbatch(Seq() $_) { | |
# (Seq.new: class :: does Iterator { | |
# has Iterator $.baseit; | |
# has Bool $.exhausted is rw; | |
# method pull-one { | |
# my $next; | |
# my $remaining = $*batchsize; | |
# $.exhausted | |
# ?? IterationEnd | |
# !! do while $remaining-- { | |
# if ($next := $.baseit.pull-one) =:= IterationEnd { | |
# $.exhausted = $next =:= IterationEnd; | |
# last; | |
# } | |
# $next | |
# } | |
# } | |
# }.new(baseit => .iterator)) does BatchedSeq | |
# } | |
# | |
# my $*batchsize = 1; | |
# | |
# for dynbatch('a'..'z') { | |
# $*batchsize++; | |
# .say; | |
# } | |
# | |
# multi dynrace(BatchedSeq $_ is raw, :$degree = 3 // $*KERNEL.cpu-cores - 1) { | |
# class :: { | |
# class Work { has &.code; has Supply $.data; } | |
# | |
# has $.seq is required; | |
# has $.work is rw; | |
# has $.input = Channel.new; | |
# has $.results = Supplier.new; | |
# has @.workers; | |
# | |
# submethod TWEAK { | |
# for ^$degree { | |
# note 'adding worker'; | |
# | |
# self.workers.push: start { | |
# react whenever self.input -> @chunk { | |
# LAST done; | |
# self.results.emit: | |
# @chunk.map(self.work); | |
# } | |
# note 'removing worker'; | |
# } | |
# } | |
# note 'done setup'; | |
# } | |
# | |
# method map(&code) { | |
# my $data = Supply.from-list($.seq); | |
# $.work = &code; | |
# | |
# $.results.Supply.tap: { .say } | |
# # for $.seq { $.input.send: $_ } | |
# $.input.send($_) for $.seq; | |
# $.input.close; | |
# | |
# await @.workers; | |
# } | |
# method grep(&c) { } | |
# }.new(seq => $_) | |
# } | |
# | |
# my \foo = dynbatch(1..30); | |
# dynrace(foo).map({$_}); | |
# | |
# # for dynbatch(1..1000).&dynrace.map({ dd .item; sleep 0.1; .item ** 2 }) { | |
# # $*batchsize = ++$; | |
# # .say | |
# # } | |
# } | |
# { | |
# use nqp; | |
# my @a = ('a' .. 'z').List; | |
# my $reified := nqp::getattr(@a,List,'$!reified'); | |
# # say nqp::existspos($reified, 1); | |
# # say nqp::atpos($reified, 1); | |
# # @a[1,2]:delete; | |
# # say nqp::existspos($reified, 1); | |
# # say nqp::atpos($reified, 1); | |
# | |
# # multi sub prune(@a, :$fp!) { | |
# # my uint $i = 0; | |
# # my $reified := nqp::getattr(@a,List,'$!reified'); | |
# | |
# # sub pull-one is raw { | |
# # nqp::ifnull( | |
# # nqp::atpos($reified, $i++), | |
# # nqp::if( | |
# # nqp::islt_i($i, nqp::elems($reified)), | |
# # pull-one, | |
# # IterationEnd | |
# # ) | |
# # ) | |
# # } | |
# # } | |
# | |
# # multi sub prune(@a, &c) { | |
# # my &it = prune @a, :fp; | |
# # do while ($_ := it()) !=:= IterationEnd { | |
# # c($_) | |
# # } | |
# # } | |
# | |
# # multi sub prune(*@a --> Seq) { | |
# # Seq.new: class :: does Iterator { | |
# # has uint $!i; | |
# # has $!reified; | |
# # submethod !SET-SELF(\arr) { | |
# # $!reified := nqp::getattr(@a,List,'$!reified'); | |
# # $!i = 0; | |
# # } | |
# # method new(\arr) { nqp::create(self)!SET-SELF(arr) } | |
# # method pull-one is raw { | |
# # nqp::ifnull( | |
# # nqp::atpos($reified, $!i++), | |
# # nqp::if( | |
# # nqp::islt_i($!i, nqp::elems($reified)), | |
# # self.pull-one, | |
# # IterationEnd | |
# # ) | |
# # ) | |
# # } | |
# # }.new(@a) | |
# # } | |
# | |
# multi sub prune(@a, Int:D $i --> Seq:D) { | |
# prune @a, $i .. $i | |
# } | |
# | |
# multi sub prune(@a, +@l is copy --> Seq:D) { | |
# @l = @l.sort; | |
# | |
# Seq.new: class :: does Iterator { | |
# has int $!i; | |
# has $!reified; | |
# submethod !SET-SELF(\arr) { | |
# $!reified := nqp::getattr(@a,List,'$!reified'); | |
# $!i = -1; | |
# self | |
# } | |
# method new(\arr) { nqp::create(self)!SET-SELF(arr) } | |
# method pull-one is raw { | |
# loop { | |
# ++$!i; | |
# if @l { | |
# @l.shift while +@l && $!i > @l[0].max; | |
# next if +@l && @l[0].min ≤ $!i ≤ @l[0].max; | |
# } | |
# return nqp::ifnull( | |
# nqp::atpos($reified, $!i), | |
# nqp::if( | |
# nqp::isge_i($!i, nqp::elems($reified)), | |
# IterationEnd, | |
# next # we actually got a hole | |
# ) | |
# ); | |
# } | |
# } | |
# }.new(@a) | |
# } | |
# | |
# @a = ('a' .. 'z').List; | |
# | |
# dd @a.&prune( 25 ); | |
# dd @a.&prune( 10..15 ); | |
# dd @a.&prune( (2,3,10..15, 21..22, 25).pick(5) ); | |
# @a[2,3,10..15, 21..22, 25]:delete; | |
# dd @a; | |
# } | |
# { | |
# sub exclude(@a, $elems) { | |
# say (0..^$elems).grep: * !~~ @a | |
# } | |
# | |
# my @a = 0..9; | |
# @a[&exclude.assuming(2..3)].say; | |
# @a[{ (0..^$_).grep: * !~~ 2..3 }].say; | |
# } | |
# { | |
# # Generate an array of pascal sequence. | |
# sub pascal-sequence(Int:D $number) { | |
# my @k; | |
# gather { | |
# for 1..$number { | |
# @k = 1, | @k »+» (| @k[1..*], 0); | |
# take @k[]:v; | |
# } | |
# } | |
# } | |
# | |
# sub AIN(Int:D $rows where $rows >= 3) { | |
# my @pascal = (pascal-sequence $rows); | |
# say @pascal; # OUTPUT: [[1 4 6 4 1] [1 4 6 4 1] [1 4 6 4 1] [1 4 6 4 1] [1 4 6 4 1]] | |
# say (pascal-sequence $rows); # OUTPUT: ([1] [1 1] [1 2 1] [1 3 3 1] [1 4 6 4 1]) | |
# } | |
# | |
# AIN(5); | |
# | |
# my \pascal = (1,), (1,1), -> @a { 1, |(@a «+» (|@a[1..*], 0)) } … *; | |
# say pascal[^10]; | |
# } | |
# { | |
# sub infix:<joker>(\a, \b) { &*joker(a, b) } | |
# | |
# my &*joker = { $^a x $^b }; | |
# | |
# say [joker] 1,2,3; | |
# } | |
# { | |
# my Str $foo is default('hola') = 'Hello'; | |
# constant $bar = "--$foo--"; | |
# say $bar; | |
# } | |
# { | |
# my $side-effect = Empty; | |
# subset Funky of Int where { $side-effect = $_ }; | |
# sub foo(Funky $f) { say $side-effect } | |
# foo(42); | |
# } | |
# { | |
# my Str() @a = ('foo=10' ~~ /$<a>=[\w+] '=' $<b>=[\d+]/)<a b>; .say for @a; | |
# say ('foo=bar=10' ~~ /$<a>=('foo' '=' $<b>=('bar' '=' $<c> = [\d+]))/){||<a b c>}; | |
# } | |
# { | |
# my %h = :1BaRr, :2foo; my &f = { say 'f' }; say so %h ~~ rx:i/bar/; | |
# | |
# } | |
# { | |
# # `.roll(*)` on this sizable Range returns a lazy list, and so does `grep` | |
# # `.first` will collapse that list to a single value | |
# (1_000_000..10_000_000).roll(*).grep(*.is-prime).first.say; | |
# | |
# # Routines don't operate by default an plural values, but we can use operators | |
# # and explicit syntax for this. | |
# | |
# # `.hyper` will spawn a bunch of threads and the subsequent `.grep` will use them | |
# # `».` may also spawn threads and call the following method on the list of invocants | |
# (1_000_000..10_000_000).roll(*).hyper(:degree(12)).grep(*.is-prime).head(10)».say; | |
# | |
# # By prefixing an @-sigiled parameter with a `+`, the sub will accept | |
# # single values, lists, list-like stuff like ranges and infinite lists (by | |
# # maintaining lazyness). | |
# sub foo(+@a) { | |
# say @a; # `say` will deal gracefully with infinite lists | |
# } | |
# | |
# foo 1; | |
# foo 1,2,3; | |
# foo 1..∞; | |
# | |
# say Q:c:to/■/; | |
# Quoting is Raku is complete. You can choose fine grained what is | |
# interpolated and what isn't. Here I only want { 'CODE-'.lc }blocks to | |
# be evaluated. Any other sequence of special meaning, like \a, will | |
# remain verbatim. If the terminator is indented, that indentation will | |
# be removed automatiacally. | |
# ■ | |
# | |
# # Raku does FP with operatirs. `[max]` is not special cased. A new | |
# # reduction operator is injected into the grammar when an infix operator | |
# # in brackets is used. | |
# say [max] 3,42,8; | |
# | |
# # That wouldn't be much fun if you couldn't define your own infix operators. | |
# sub infix:<max=>(\a, \b) { max(a, b) } | |
# | |
# # `.grep` is fairly smart. It recognises that the block got two arguments | |
# # and will loop over pairs of values. Blocks are code objects and Raku | |
# # allows intospection of argument lists. The compiler does make use of that | |
# # itself. (In fact, there is very little you can't introspect at runtime, | |
# # because compile-time doesn't really stop.) | |
# (1..10).pick(*).grep({$^a max= $^b}).say; | |
# | |
# # Raku doesn't sport date-literals by default. However, it's grammar isn't | |
# # fixed. Rakudo is a dynamic compiler for a dynamic language. You could | |
# # write a slang to add any syntax to the language, so long it doesn't | |
# # clash with existing syntax. If it does, we can't stop you from forking | |
# # the compiler and thus the language. | |
# | |
# sub MAIN( | |
# #| Number of repetitions up to 99, defaults to 1. | |
# Int :$n where 1 ≤ * < 100 = 1 | |
# ){ | |
# say ‘This does what it looks like it does.’ xx $n; | |
# say «And yes, you can use unicode quote characters to do your bidding.»; | |
# } | |
# | |
# # We don't got symbols, but we can use a label that points to a NOP for that. | |
# a-label: Nil; # kebab-case? We sure do! | |
# another-label: Nil; | |
# | |
# use Test; # This module comes with the compiler (and is used by the compiler). | |
# | |
# ok a-label === a-label, 'label tests agaisnt itself numerically'; | |
# nok a-label === another-label, 'two labels are distinct numerically'; | |
# | |
# ok a-label =:= a-label, 'label tests agaisnt itself by identity'; | |
# nok a-label =:= another-label, 'two labels are distinct by identity'; | |
# | |
# ok a-label ~~ a-label, 'label tests agaisnt itself by smartmatch'; | |
# nok a-label ~~ another-label, 'two labels are distinct by smartmatch'; | |
# | |
# # Labels are objects and thus got methods. | |
# put another-label.name; | |
# # since Label knows where it was defined, we can use it to point to spots | |
# # in the source code at runtime. | |
# say another-label; | |
# } | |
# { | |
# my $a = 7/1; | |
# multi foo(Int:D(Numeric) $_ where { $_ == .Int }) { .is-prime } | |
# multi foo($_ where { $_ =~= .round }) { .round.is-prime } | |
# say foo $a; | |
# say foo '6.999999999999999999999999999999999999999'; | |
# } | |
# { | |
# my $s = q:to/EOH/; | |
# █████ ░░░░░ █████ █████ ░░░░░ █████ █████ █████ █████ █████ | |
# █ █ ░ █ ░ █ ░ █ █ █ █ ░ █ ░ ░ █ █ █ █ █ | |
# █ █ ░ █ ░ █ ░ █ █ █ █ ░ █ ░ ░ █ █ █ █ █ ██ | |
# █ █ ░ █ ░ █ ░ █ █ █ █ ░ █ ░ ░ █ █ █ █ █ ██ | |
# ░░░░░ ░░░░░ █████ █████ █████ █████ █████ ░░░░░ █████ █████ | |
# █ █ ░ █ █ ░ ░ █ ░ █ ░ █ █ █ ░ █ █ █ ░ █ ██ | |
# █ █ ░ █ █ ░ ░ █ ░ █ ░ █ █ █ ░ █ █ █ ░ █ ██ | |
# █ █ ░ █ █ ░ ░ █ ░ █ ░ █ █ █ ░ █ █ █ ░ █ | |
# █████ ░░░░░ █████ █████ ░░░░░ █████ █████ ░░░░░ █████ ░░░░░ | |
# EOH | |
# | |
# my @digits = $s.lines».comb(8); | |
# | |
# @digits.join("\n").print; | |
# put ""; | |
# | |
# sub display($what) { | |
# my @screen; | |
# for $what.comb.map({ $_ eq ':' ?? 10 !! $_ }).kv -> $k, $v { | |
# @screen[^9; $k] = @digits[^9; $v]; | |
# } | |
# | |
# @screen.join("\n").print | |
# } | |
# | |
# loop { | |
# put "\e[2J"; | |
# display now.DateTime.local.&{ sprintf '%02d:%02d:%02d', .hour, .minute, .second }; | |
# sleep 1; | |
# } | |
# } | |
{ | |
my $str = Q:c:to/■/; | |
Hello { say $_ }! | |
■ | |
say $str; | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment