Raku By Example
View me onGitHub 
## arguments capture

my @a=1,2,3;
my $s='Escape Plan';
my %h='Rakudo'=>'Star','STD'=>'Larry';

# 捕获就是一系列实参的签名
my $capture = \(@a,$s,%h);      # creating a capture, "\" was free since there are no references anymore
say(|$capture).perl;            # flatten into argument list (hash like context)
# ||$cap;                       # flatten into semicolon list (array like context)

## captures

# A set of parameters form a signature. 一组形参组成签名
# A set of arguments form a capture.    一组实参组成捕获

sub greet($name, :$greeting = 'Hi') {
    say "$greeting, $name!";
}
greet('Лена', greeting => 'Привет');

## colon in  signature

use MONKEY-SEE-NO-EVAL;

# -r=xxx -s=yyy -e=zzz -i=123
# usage: perl6 colon_in_signature.p6  -r="\d ** 3" -s="在木星" -i=2 1.txt 2.txt 3.txt
multi sub MAIN(Str :r(:$regex), Str :s(:$substr), Str :e(:$ext) = '.out', Int :i(:$ignore-line) = 0, *@files) {
    for @files -> $file {
        my $out = open $file ~ ".out", :w; # 写入文件

        for $file.IO.lines.kv -> $index, $line is copy {
            next if $index <= $ignore-line; # 忽略前 $ignore-line几行
            $line ~~ EVAL "s/" ~ $regex ~ "/" ~ $substr ~ "/"; # 根据正则表达式进行替换
            say $/;
            $out.say($line);
        }
        $out.close;
    }
}

# 查看本脚本的用法
# perl6 colon_in_signature.p6 --help

# Usage:
#  colon_in_signature.p6 [-r|--regex=<Str>] [-s|--substr=<Str>] [-e|--ext=<Str>] [-i|--ignore-line=<Int>] [<files> ...]

# 可以看出命令行选项有短名称(如 -r)和长名称(如 --regex)。

## colon 

sub rectangle(:$width!, :$height!, :$char = 'X') {
    say $char x $width for ^$height;
}

rectangle char => 'o', width => 8, height => 4;
rectangle :width(20), :height<5>;

## constraining defined and undefined values

multi  limit-lines (Str $s, Int:D $limit) {
    my @lines = $s.lines;
    @lines[0 ..^ min @lines.elems, $limit].join("\n");
}

multi limit-lines (Str $s, Int:U $) {$s}
say (limit-lines "a \n b \n c \n d \n", 3).perl;
# say limit-lines Str, 3;
# say limit-lines "a \n b", Int;
say limit-lines "a \n b \n c", Int;


sub f(::T $p1, T $p2, ::C) {
    # $p1 和 $p2 的类型都为 T, 但是我们还不知道具体类型是什么
    # C 将会保存一个源于类型对象或值的类型
    my C $closure = $p1 / $p2;
    return sub (T $p1) {
        $closure * $p1;
    }
}

# 第一个参数是 Int 类型, 所以第二个参数也是
# 我们从调用用于 &f 中的操作符导出第三个类型
my &s = f(10,2, Int.new / Int.new);
say s(2);  # 10 / 2 * 2  == 10

say 'x' x 55;

multi ff(:$named) { note &?ROUTINE.signature }
multi ff(:$also-named) { note &?ROUTINE.signature }

for 'named', 'also-named' -> $n {
    ff(|($n => rand));      # «(:$named)␤(:$also-named)␤»
}

## constraint warnings

# Be careful about using type constraints on arrays and hashes. The type constraints the elements.
# 在对数组和散列使用类型限制时要小心. 类型限制的是元素!

multi sub total(Array @distances) { # 限制数组 @distances 中的每个元素为数组.
    # WRONG! Takes an Array of Arrays!
}

multi sub total(Int @distances) {
    # Correct, takes an array of Ints.
}

## constraints

# Sometimes, you need to do some more powerful validation on arguments.

sub discount($price, $percent
             where (1 <= $percent <= 100)) {
    say "You get $percent% off! Pay EUR " ~ $price - ($price * $percent / 100);
}
discount(100, 20);
discount(100, 200);

## cont down

constant term:<ANSI-SAME-LINE> = "\e[1F\e[0K";

subset Seconds of Numeric;
my regex number { \d+ [ '.' \d+ ]? }

my %unit-multipliers = 'd' => 60*60*24, 'h' => 60*60, 'm' => 60, 's' => 1; # 每天, 每小时, 每分钟, 每秒所对应的秒数

multi sub pretty-print(Seconds $seconds is copy --> Str) {
    my @ret;
    for %unit-multipliers.sort(-*.value) -> (:key($unit), :value($multiplier)) {
        @ret.push: $seconds.Int div $multiplier ~ $unit if $seconds.Int div $multiplier;
        $seconds = $seconds % $multiplier;
    }
    @ret.join: ' ';
}

multi sub MAIN(Seconds $to-wait) {
    MAIN($to-wait ~ 's');
}

# eg： @timicles => [0.5m 10s]
multi sub MAIN(*@timicles where .all ~~ /<number> <[dhms]>/) {
    my Seconds $to-wait = @timicles».\
        split(/<number>/, :v).\
        map(-> [$,Rat(Any) $count, Str(Any) $unit] --> Seconds { %unit-multipliers{$unit} * $count }).\
        sum;

    react {
        whenever Promise.in($to-wait) {
            exit 0;
        }

        whenever signal(SIGINT) {
            exit 1;
        }

        whenever Supply.interval(1) {
            state $count-down = $to-wait;
            say ANSI-SAME-LINE ~ pretty-print($count-down--);
        }
    }
}

sub USAGE {
print Q:c:to/EOH/;
    Usage: {$*PROGRAM-NAME} NUMBER[SUFFIX]…
    Display a countdown for the specified time. Decimal fractions are supported for
    NUMBER and suffixes for [d]ays, [h]ours, [m]inutes or [s]econds are
    recognized. If the countdown is exhausted exit with 0.

    Receiving SIGNIT will interrupt the countdown and result in exitcode 1.
EOH
}

## dispatch by arity

# Dispatch By Arity(he number of arguments that a function can take)
# Example (from Test.pm): dispatch by different number of parameters

multi sub todo($reason, $count) is export {
    $todo_upto_test_num = $num_of_tests_run + $count;
    $todo_reason = '# TODO ' ~ $reason;
}

multi sub todo($reason) is export {
    $todo_upto_test_num = $num_of_tests_run + 1;
    $todo_reason = '# TODO ' ~ $reason;
}

## dispatch by constraint

# Can use multiple dispatch with constraints to do a lot of "write what you know" style solutions

# Factorial:
# fact(0) = 1
# fact(n) = n * fact(n - 1)

multi fact(0)  { 1 };
multi fact($n) { $n * fact($n - 1) };

say fact(10);


# Fibonacci Sequence:
# fib(0) = 0
# fib(1) = 1
# fib(n) = fib(n - 1) + fib(n - 2)

# mutil 声明的子例程语句结尾不需要跟分号;
multi fib(0)  { 0 }
multi fib(1)  { 1 }
multi fib($n) { fib($n - 1) + fib($n - 2) }

say fib(10);

## ---

## dispatch by type

# Example: part of a JSON emitter

multi to-json(Array $a) {
    return '[ ' ~
        $a.values.map({ to-json($_) }).join(', ') ~
        ' ]';
}

multi to-json(Hash $h) {
    return '{ ' ~
        $h.pairs.map({
            to-json(.key) ~ ': ' ~ to-json(.value)
        }).join(', ') ~
        ' }';
}

## ---

## destruct
sub fst(*@ [$fst]){
    say $fst;
}

fst(1);
fst(1,2);

## ---

sub is-in(@array, $elem) {
  # this will `return` out of the `is-in` sub
  # once the condition evaluated to True, the loop won't be run anymore
  map({ return True if $_ ==  $elem }, @array);
}

my @array = 1,2,3,4,5;
is-in(@array,3);

## ---

## junction as hash keys

subset Seconds of Numeric;
my regex number { \d+ [ '.' \d+ ]? } # float 
my regex suffix { <[dhms]> }

my %unit-multipliers = 'd' => 60*60*24, 'h' => 60*60, 'm' => 60, 's' => 1; # 每天, 每小时, 每分钟, 每秒所对应的秒数

# @timicles => [0.5m 10s]
sub MAIN(*@timicles where .all ~~ /<number> <[dhms]>/) {
    my Seconds $to-wait = @timicles»\
        .match(/<number> <suffix>+/)».hash\ # the +-quatifier is a workaround
        .map(-> % ( Rat(Any) :$number, Str(Any) :$suffix ) {say $suffix; %unit-multipliers{$suffix} * $number })\
        .sum;
    say $to-wait ~ "s";
}

## ---

## lexically scoped

sub escape ($str) {
    $_ = $str;
    # Puts a slash before non-alphanumeric characters
    s:g[<-alpha-digit>] = "\\$/";
}

say escape "foobar";

{
    sub escape ($str) {
        $_ = $str;
        # Writes each non-alphanumeric character in its hexadecimal escape
        s:g[<-alpha-digit>] = "\\x[{ $/.base(16) }]";
    }

    say escape "foo#bar?"; # foo\x[23]bar\x[3F]
}

# Back to original escape function
say escape "foo#bar?";

## ---

## optional parameters

sub greet($name, $greeting = 'Ahoj') {
    say "$greeting, $name!";
}
greet('Anna'); # Ahoj Anna 
greet('Лена', 'Привет '); # Привет, Лена"

## ---

## passing arrays and hashes

# In Perl 6, passing an array or hash works like passing a reference

sub example(@array, %hash) {
    say @array.elems;
    say %hash.keys.join(", ");
}

my @numbers = 1,2,3,4;
my %ages = Jnthn => 25, Noah => 120;
example(@numbers, %ages);

## ---

## positional signatures

use fatal;

sub foo( Int @nums ) {
    say @nums.join(" ");
}

sub bar( UInt @nums ) {
    say @nums.join(" ");
}

my UInt @nums = (1, 2);
say "foo: ";
foo(@nums);
say "bar: ";
bar(@nums);

## ---

## quick sort

# Empty list sorts to the empty list
multi quicksort([]) { () }

# Otherwise, extract first item as pivot...
multi quicksort([$pivot, *@rest]) {

    # Partition.
    my @before = @rest.grep(* < $pivot);
    my @after  = @rest.grep(* >= $pivot);
    # Sort the partitions.
    (quicksort(@before), $pivot, quicksort(@after))
}

my @unsorted = <13 1 9 12 4 2015>;
say quicksort(@unsorted); # 1  4  9  12  13  2015

## ---

## read only

sub convert_currency($amount, $rate) {
    $amount = $amount * $rate;
    return $amount;
}

sub convert_currency_copy($amount is copy, $rate) {
    $amount = $amount * $rate;
    return $amount;
}

sub convert_currency_rw($amount is rw, $rate) {
    $amount = $amount * $rate;
    return $amount;
}

my $price = 99;
$price = convert_currency($price, 11.1);
$price_copy = convert_currency_copy($price, 11.1);
$price_rw = convert_currency_rw($price, 11.1);

say $price;
say $price_copy;
say $price_rw;

## ---

## signature destructuring

my %hhgttg = (:40life, :41universe, :42everything);
for %hhgttg -> (:$key, :$value) {
    say "$key → $value";
}

## ---

## capture in signature

my $sig = :(Int $i, Str $s);
say (10, 'answer') ~~ $sig;
# OUTPUT: «True␤»
my $sub = sub ( Str $s, Int $i ) { return $s xx $i };
say $sub.signature ~~ :( Str, Int );
# OUTPUT: «True␤»
given $sig {
    when :(Str, Int) { say 'mismatch' }
    when :($, $)     { say 'match' }
    default          { say 'no match' }
}
# OUTPUT: «match␤»

## ---

## time unit

subset Seconds of Numeric;
my regex number { \d+ [ '.' \d+ ]? } # float 
my regex suffix { <[dhms]> }

my %unit-multipliers = 'd' => 60*60*24, 'h' => 60*60, 'm' => 60, 's' => 1; # 每天, 每小时, 每分钟, 每秒所对应的秒数

# @timicles => [0.5m 10s]
sub MAIN(*@timicles where .all ~~ /<number> <[dhms]>/) {
    my Seconds $to-wait = @timicles»\
        .match(/<number> <suffix>+/)».hash\ # the +-quatifier is a workaround
        .map(-> % ( Rat(Any) :$number, Str(Any) :$suffix ) { %unit-multipliers{$suffix} * $number })\
        .sum;
    say $to-wait ~ "s";
}

## ---

## total seconds

subset Seconds of Numeric;

my %unit-multipliers = 'd'|'day' => 60*60*24, 'h'|'hour' => 60*60, 'm'|'min' => 60, 's'|'sec' => 1;
my @units = %unit-multipliers.keys;

my regex number { \d+ [ '.' \d+ ]? }
my regex suffix { @units }

# @timicles => [0.5m 10s 0.5min, 10sec 1day 1d]
sub MAIN(*@timicles where .all ~~ /<number> @units $/) {
    my Seconds $to-wait = @timicles»\
        .match(/<number> <suffix> $/)».hash
        .map(-> % ( :$number, :$suffix ) { %unit-multipliers{$suffix} * $number })\
        .sum;
    say $to-wait ~ "s";
}

# Usage: perl6 program.pl6 0.5m 10s 0.5min 10sec 1day 1d

## ---

## type coercions

# Sometimes, you want to accept any type, but then transform it into another type before binding to the parameter
# 强制类型转换

sub show_dist($from, $to, $kms as Int) {
   say "From $from to $to is $kms km.";
}
show_dist('Kiev', 'Lviv', '469');
show_dist('Kiev', 'Lviv', 469.35);

## ---

## type constrains

# Can restrict a parameter to only accept arguments of a certain type.


sub show_dist(Str $from, Str $to, Int $kms) {
    say "From $from to $to is $kms km.";
}
show_dist('Kiev', 'Lviv', 469);
show_dist(469, 'Kiev', 'Lviv'); #  Error!

## ---

## unpacking arrays

# Unpacking Arrays
# Can extract elements from within an array, to do FP-style list processing

sub head([$head, *@tail]) {
    return $head;
}

sub tail([$head, *@tail]) {
    return @tail;
}

my @example = 1,2,3,4;
say head(@example);
say tail(@example);

## ---

## unpacking hashes

# Unpacking Hashes

# Can extract values by key

sub show_place((:$name, :$lat, :$long, *%rest)) {
    say "$name lies at $lat,$long.";
    say "Other facts:";
    for %rest.kv -> $title, $data {
        say "    $title.wordcase(): $data";
        }
}

my %info = name => 'Kiev', lat => 50.45,
long => 30.52, population => 2611300;
show_place(%info);

## ---

## unpacking objects

# Can extract values by attribute (only those that are declared with accessors)

sub nd($r as Rat (:$numerator, :$denominator)) {
    say "$r = $numerator/$denominator";
}
nd(4.2);
nd(3/9);

## ---

## unpacking slurp

sub slurp-in-array(@ [$fst, *@rest]) { # You could keep `*@rest` anonymous
  say $fst + @rest.elems;   # `.elems` returns a list's length.
                            # Here, `@rest` is `(3,)`, since `$fst` holds the `2`.
}
my @array = <2 3 4 5>;
slurp-in-array(@array);

## ---

## unpacking 

sub  foo(@array [$fst, $snd]) {
  say "My first is $fst, my second is $snd ! All in all, I'm @array[].";
  # (^ remember the `[]` to interpolate the array)
}
my @tail = 1,2;
foo(@tail);

 #=> My first is 2, my second is 3 ! All in all, I'm 2 3