Skip to content

Commit

Permalink
Merge branch 'master' of https://github.com/rakudo/rakudo into rakudo…
Browse files Browse the repository at this point in the history 
…_3028
  • Loading branch information
@vrurg
vrurg committed Jul 8, 2019
2 parents 0a05cbd + a46c414 commit db5214c
Show file tree
Hide file tree
Showing 8 changed files with 52 additions and 49 deletions.
2 changes: 1 addition & 1 deletion lib/NativeCall.pm6
View file
Expand Up @@ -389,7 +389,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi
QAST::Var.new(:scope<local>, :name($lowered_name)),
$_.type ~~ Str ?? Str
!! $_.type ~~ Int ?? QAST::IVal.new(:value(0))
!! $_.type ~~ Num ?? QAST::NVal.new(:value(0))
!! $_.type ~~ Num ?? QAST::NVal.new(:value(0e0))
!! QAST::IVal.new(:value(0))
),
);
Expand Down
22 changes: 11 additions & 11 deletions src/Perl6/Actions.nqp
View file
Expand Up @@ -8185,7 +8185,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
make $*W.add_numeric_constant($/, 'Num', nqp::inf);
}
else {
make $*W.add_numeric_constant($/, 'Num', +$/);
make $*W.add_numeric_constant($/, 'Num', nqp::numify($/));
}
}

Expand All @@ -8197,7 +8197,7 @@ class Perl6::Actions is HLL::Actions does STDActions {

method dec_number($/) {
if $<escale> { # wants a Num
make $*W.add_numeric_constant: $/, 'Num', ~$/;
make $*W.add_numeric_constant: $/, 'Num', nqp::numify($/);
} else { # wants a Rat
my $Int := $*W.find_symbol(['Int']);
my $parti;
Expand Down Expand Up @@ -8320,12 +8320,12 @@ class Perl6::Actions is HLL::Actions does STDActions {
my $ast := $*W.add_constant: 'Complex', 'type_new', :nocache(1),
$*W.add_constant('Num', 'num',
$<re><sign> eq '-' || $<re><sign> eq '−'
?? -$<re><number>.ast.compile_time_value.Num
?? nqp::neg_n($<re><number>.ast.compile_time_value)
!! $<re><number>.ast.compile_time_value.Num
).compile_time_value,
$*W.add_constant('Num', 'num',
$<im><sign> eq '-' || $<im><sign> eq '−'
?? -$<im><number>.ast.compile_time_value.Num
?? nqp::neg_n($<im><number>.ast.compile_time_value)
!! $<im><number>.ast.compile_time_value.Num
).compile_time_value;
$ast.node($/);
Expand Down Expand Up @@ -10950,7 +10950,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions {
QAST::SVal.new( :value('INTERPOLATE') ),
$varast,
QAST::IVal.new( :value(%*RX<i> && %*RX<m> ?? 3 !! %*RX<m> ?? 2 !! %*RX<i> ?? 1 !! 0) ),
QAST::IVal.new( :value(monkey_see_no_eval($/)) ),
QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ),
QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ),
QAST::IVal.new( :value(0) ),
QAST::Op.new( :op<callmethod>, :name<new>,
Expand All @@ -10966,7 +10966,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions {
QAST::SVal.new( :value('INTERPOLATE_ASSERTION') ),
$<codeblock>.ast,
QAST::IVal.new( :value(%*RX<i> && %*RX<m> ?? 3 !! %*RX<m> ?? 2 !! %*RX<i> ?? 1 !! 0) ),
QAST::IVal.new( :value(monkey_see_no_eval($/)) ),
QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ),
QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ),
QAST::IVal.new( :value(1) ),
QAST::Op.new( :op<callmethod>, :name<new>,
Expand Down Expand Up @@ -11004,7 +11004,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions {
QAST::SVal.new( :value('INTERPOLATE_ASSERTION') ),
wanted($<var>.ast, 'assertvar2'),
QAST::IVal.new( :value(%*RX<i> && %*RX<m> ?? 3 !! %*RX<m> ?? 2 !! %*RX<i> ?? 1 !! 0) ),
QAST::IVal.new( :value(monkey_see_no_eval($/)) ),
QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ),
QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ),
QAST::IVal.new( :value(1) ),
QAST::Op.new( :op<callmethod>, :name<new>,
Expand Down Expand Up @@ -11166,9 +11166,9 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions {
QAST::SVal.new( :value($*INTERPOLATION ?? 'INTERPOLATE_ASSERTION' !! 'INTERPOLATE') ),
$<codeblock>.ast,
QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ),
QAST::IVal.new( :value(monkey_see_no_eval($/)) ),
QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ),
QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ),
QAST::IVal.new( :value($*INTERPOLATION) ),
QAST::IVal.new( :value($*INTERPOLATION ?? 1 !! 0) ),
QAST::Op.new( :op<callmethod>, :name<new>,
QAST::WVal.new( :value($*W.find_symbol(['PseudoStash']))),
),
Expand All @@ -11182,9 +11182,9 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions {
QAST::SVal.new( :value($*INTERPOLATION ?? 'INTERPOLATE_ASSERTION' !! 'INTERPOLATE') ),
wanted($<var>.ast, 'p5var'),
QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ),
QAST::IVal.new( :value(monkey_see_no_eval($/)) ),
QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ),
QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ),
QAST::IVal.new( :value($*INTERPOLATION) ),
QAST::IVal.new( :value($*INTERPOLATION ?? 1 !! 0) ),
QAST::Op.new( :op<callmethod>, :name<new>,
QAST::WVal.new( :value($*W.find_symbol(['PseudoStash']))),
),
Expand Down
9 changes: 5 additions & 4 deletions src/Perl6/Optimizer.nqp
View file
Expand Up @@ -1606,7 +1606,7 @@ class Perl6::Optimizer {
# a hllbool if there's already an integer result behind it. For if/unless,
# we can only do that when we have the `else` branch, since otherwise we
# might return the no-longer-Bool value from the conditional.
elsif (+@($op) == 3 && ($optype eq 'if' || $optype eq 'unless'))
elsif ((+@($op) == 3 || $!void_context) && ($optype eq 'if' || $optype eq 'unless'))
|| $optype eq 'while' || $optype eq 'until' {
my $update := $op;
my $target := $op[0];
Expand All @@ -1619,8 +1619,9 @@ class Perl6::Optimizer {
$update[0] := $target[0];
}
}
elsif nqp::istype($target,QAST::Var) && $target.scope eq 'lexicalref' && nqp::objprimspec($target.returns) == 1 {
elsif nqp::istype($target,QAST::Var) && ($target.scope eq 'lexicalref' || $target.scope eq 'attributeref' || $target.scope eq "localref") && nqp::objprimspec($target.returns) == 1 {
# turn $i into $i != 0
$target.scope($target.scope eq 'lexicalref' ?? 'lexical' !! $target.scope eq 'attributeref' ?? 'attribute' !! 'local');
$update[0] := QAST::Op.new( :op('isne_i'), :returns($target.returns), $target, QAST::IVal.new( :value(0) ));
}
}
Expand Down Expand Up @@ -2146,7 +2147,7 @@ class Perl6::Optimizer {
}
}
elsif $primspec == 2 { # native num
my $one := QAST::NVal.new: :value(1);
my $one := QAST::NVal.new: :value(1.0);
if $!void_context || nqp::eqat($op.name, '&pre', 0) {
# we can just use (or ignore) the result
return QAST::Op.new: :op<assign_n>, :$node, :$returns, $var,
Expand Down Expand Up @@ -3161,7 +3162,7 @@ class Perl6::Optimizer {
# Looks through positional args for any lexicalref or attributeref, and
# if we find them check if the expectation is for an non-rw argument.
method simplify_refs($call, $sig) {
if $sig.arity == $sig.count {
if nqp::iseq_n($sig.arity, $sig.count) {
my @args := $call.list;
my int $i := $call.name eq '' ?? 1 !! 0;
my int $n := nqp::elems(@args);
Expand Down
38 changes: 19 additions & 19 deletions src/Perl6/World.nqp
View file
Expand Up @@ -97,37 +97,37 @@ sub levenshtein($a, $b) {
my $achar := nqp::substr($a, $apos, 1);
my $bchar := nqp::substr($b, $bpos, 1);

my $cost := changecost($achar, $bchar);
my num $cost := changecost($achar, $bchar);

# hyphens and underscores cost half when adding/deleting.
my $addcost := 1;
my num $addcost := 1;
$addcost := 0.5 if $bchar eq "-" || $bchar eq "_";

my $delcost := 1;
my num $delcost := 1;
$delcost := 0.5 if $achar eq "-" || $achar eq "_";

my $ca := levenshtein_impl($apos+1, $bpos, $estimate+$delcost) + $delcost; # what if we remove the current letter from A?
my $cb := levenshtein_impl($apos, $bpos+1, $estimate+$addcost) + $addcost; # what if we add the current letter from B?
my $cc := levenshtein_impl($apos+1, $bpos+1, $estimate+$cost) + $cost; # what if we change/keep the current letter?
my num $ca := nqp::add_n(levenshtein_impl($apos+1, $bpos, nqp::add_n($estimate, $delcost)), $delcost); # what if we remove the current letter from A?
my num $cb := nqp::add_n(levenshtein_impl($apos, $bpos+1, nqp::add_n($estimate, $addcost)), $addcost); # what if we add the current letter from B?
my num $cc := nqp::add_n(levenshtein_impl($apos+1, $bpos+1, nqp::add_n($estimate, $cost)), $cost); # what if we change/keep the current letter?

# the result is the shortest of the three sub-tasks
my $distance;
$distance := $ca if $ca <= $cb && $ca <= $cc;
$distance := $cb if $cb <= $ca && $cb <= $cc;
$distance := $cc if $cc <= $ca && $cc <= $cb;
my num $distance;
$distance := $ca if nqp::isle_n($ca, $cb) && nqp::isle_n($ca, $cc);
$distance := $cb if nqp::isle_n($cb, $ca) && nqp::isle_n($cb, $cc);
$distance := $cc if nqp::isle_n($cc, $ca) && nqp::isle_n($cc, $cb);

# switching two letters costs only 1 instead of 2.
if $apos + 1 <= $alen && $bpos + 1 <= $blen &&
nqp::eqat($a, $bchar, $apos + 1) && nqp::eqat($b, $achar, $bpos + 1) {
my $cd := levenshtein_impl($apos+2, $bpos+2, $estimate+1) + 1;
$distance := $cd if $cd < $distance;
my num $cd := nqp::add_n(levenshtein_impl($apos+2, $bpos+2, nqp::add_n($estimate, 1)), 1);
$distance := $cd if nqp::islt_n($cd, $distance);
}

%memo{$key} := $distance;
return $distance;
}

my $result := levenshtein_impl(0, 0, 0);
my num $result := levenshtein_impl(0, 0, 0);
return $result;
}

Expand All @@ -142,13 +142,13 @@ sub make_levenshtein_evaluator($orig_name, @candidates) {
my $parlen := nqp::chars($orig_name);
my $lendiff := nqp::chars($name) - $parlen;
$lendiff := -$lendiff if $lendiff < 0;
return 1 if $lendiff >= $parlen * 0.3;
return 1 if nqp::isge_n($lendiff, nqp::mul_n($parlen, 0.3));

my $dist := levenshtein($orig_name, $name) / $parlen;
my num $dist := nqp::div_n(levenshtein($orig_name, $name), $parlen);
my $target := -1;
$target := @candidates[0] if $dist <= 0.1;
$target := @candidates[1] if 0.1 < $dist && $dist <= 0.2;
$target := @candidates[2] if 0.2 < $dist && $dist <= 0.35;
$target := @candidates[0] if nqp::isle_n($dist, 0.1);
$target := @candidates[1] if nqp::islt_n(0.1, $dist) && nqp::isle_n($dist, 0.2);
$target := @candidates[2] if nqp::islt_n(0.2, $dist) && nqp::isle_n($dist, 0.35);
if $target != -1 {
my $name-str := nqp::box_s($name, $Str-obj);
nqp::push($target, $name-str);
Expand Down Expand Up @@ -3101,7 +3101,7 @@ class Perl6::World is HLL::World {
QAST::SVal.new( :value($r) )
}
elsif nqp::isint($r) {
QAST::IVal.new( :value($r) )
QAST::IVal.new( :value(nqp::isconcrete($r) ?? $r !! 0) )
}
else {
self.add_object_if_no_sc($r);
Expand Down
2 changes: 1 addition & 1 deletion src/core/Exception.pm6
View file
Expand Up @@ -2089,7 +2089,7 @@ my class X::Str::Trans::InvalidArg is Exception {

my class X::Str::Sprintf::Directives::Count is Exception {
has int $.args-used;
has num $.args-have;
has int $.args-have;
method message() {
"Your printf-style directives specify "
~ ($.args-used == 1 ?? "1 argument, but "
Expand Down
3 changes: 3 additions & 0 deletions src/core/Rakudo/Internals.pm6
View file
Expand Up @@ -1734,6 +1734,9 @@ implementation detail and has no serviceable parts inside"
::("Inline::Perl5").default_perl5
}
}

my %vm-sigs;
method VM-SIGNALS() { %vm-sigs ?? %vm-sigs !! %vm-sigs = nqp::getsignals }
}

# expose the number of bits a native int has
Expand Down
23 changes: 11 additions & 12 deletions src/core/signals.pm6
View file
Expand Up @@ -12,28 +12,27 @@ my enum Signal does Signal::Signally ( |do {
}
);

proto sub signal($, |) {*}
multi sub signal(Signal $signal, *@signals, :$scheduler = $*SCHEDULER) {
if @signals.grep( { !nqp::istype($_,Signal) } ).list -> @invalid {
die "Found invalid signals: {@invalid.join(', ')}"
proto sub signal(|) {*}
multi sub signal(*@signals, :$scheduler = $*SCHEDULER) {
if @signals.grep( { !nqp::istype($_,Signal) } ) -> @invalid {
die "Found invalid signals: @invalid.join(', ')"
}
@signals.unshift: $signal;

# 0: Signal not supported by host, Negative: Signal not supported by backend
my &do-warning = -> $desc, $name, @sigs {
warn "The following signals are not supported on this $desc ({$name}): "
~ "{@sigs.join(', ')}"
};
my %vm-sigs = nqp::getsignals();
sub unsupported($desc, $name, @sigs --> Nil) {
warn "The following signals are not supported on this $desc ($name): @sigs.join(', ')";
}

my %vm-sigs := Rakudo::Internals.VM-SIGNALS;
my ( @valid, @host-unsupported, @vm-unsupported );
for @signals.unique {
$_ ?? 0 < %vm-sigs{$_}
?? @valid.push($_)
!! @vm-unsupported.push($_)
!! @host-unsupported.push($_)
}
if @host-unsupported -> @s { do-warning 'system', $*KERNEL.name, @s }
if @vm-unsupported -> @s { do-warning 'backend', $*VM\ .name, @s }
if @host-unsupported -> @s { unsupported 'system', $*KERNEL.name, @s }
if @vm-unsupported -> @s { unsupported 'backend', $*VM\ .name, @s }

my class SignalCancellation is repr('AsyncTask') { }
Supply.merge( @valid.map(-> $signal {
Expand Down
2 changes: 1 addition & 1 deletion tools/templates/NQP_REVISION
View file
@@ -1 +1 @@
2019.03-259-g4300d4213
2019.03-273-gebe9672a7

0 comments on commit db5214c

Please sign in to comment.