diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm index a2e0efb9eee..a9e14b3af7e 100644 --- a/src/Perl6/Actions.pm +++ b/src/Perl6/Actions.pm @@ -2330,37 +2330,20 @@ method numish($/) { } method dec_number($/) { - my $int := $ ?? $.ast !! 0; - my $frac := $ ?? $.ast !! 0; - my $base := Q:PIR { - $P0 = find_lex '$/' - $S0 = $P0['frac'] - $I1 = length $S0 - $I0 = 0 - $I2 = 1 - loop: - unless $I0 < $I1 goto done - $S1 = substr $S0, $I0, 1 - inc $I0 - if $S1 == '_' goto loop - $I2 *= 10 - goto loop - done: - %r = box $I2 - }; + my $int := $ ?? ~$ !! "0"; + my $frac := $ ?? ~$ !! "0"; if $ { - my $exp := $[0].ast; - if $[0] eq '-' { $exp := -$exp; } - make PAST::Val.new( - :value(($int * $base + $frac) / $base * 10 ** +$exp ) , - :returns('Num') + my $exp := ~$[0]; + make PAST::Op.new( + :pasttype('call'), + PAST::Var.new(:scope('package'), :name('&str2num-num'), :namespace('Str')), + 0, $int, $frac, ($[0] eq '-'), $exp ); - } - else { + } else { make PAST::Op.new( - :pasttype('callmethod'), :name('new'), - PAST::Var.new( :name('Rat'), :namespace(''), :scope('package') ), - $int * $base + $frac, $base, :node($/) + :pasttype('call'), + PAST::Var.new(:scope('package'), :name('&str2num-rat'), :namespace('Str')), + 0, $int, $frac ); } } diff --git a/src/core/Str.pm b/src/core/Str.pm index 81aa9ec8427..cdee029f994 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -42,4 +42,81 @@ augment class Str does Stringy { }; return Buf.new(@bytes); } + + our sub str2num-int($src) { + Q:PIR { + .local pmc src + .local string src_s + src = find_lex '$src' + src_s = src + .local int pos, eos + .local num result + pos = 0 + eos = length src_s + result = 0 + str_loop: + unless pos < eos goto str_done + .local string char + char = substr src_s, pos, 1 + if char == '_' goto str_next + .local int digitval + digitval = index "0123456789", char + if digitval < 0 goto err_base + if digitval >= 10 goto err_base + result *= 10 + result += digitval + str_next: + inc pos + goto str_loop + err_base: + src.'panic'('Invalid radix conversion of "', char, '"') + str_done: + %r = box result + }; + } + + our sub str2num-base($src) { + Q:PIR { + .local pmc src + .local string src_s + src = find_lex '$src' + src_s = src + .local int pos, eos + .local num result + pos = 0 + eos = length src_s + result = 1 + str_loop: + unless pos < eos goto str_done + .local string char + char = substr src_s, pos, 1 + if char == '_' goto str_next + result *= 10 + str_next: + inc pos + goto str_loop + err_base: + src.'panic'('Invalid radix conversion of "', char, '"') + str_done: + %r = box result + }; + } + + our sub str2num-rat($negate, $int-part, $frac-part is copy) is export { + $frac-part.=subst(/(\d)0+$/, { ~$_[0] }); + my $result = upgrade_to_num_if_needed(str2num-int($int-part)) + + upgrade_to_num_if_needed(str2num-int($frac-part)) + / upgrade_to_num_if_needed(str2num-base($frac-part)); + $result = -$result if $negate; + $result; + } + + our sub str2num-num($negate, $int-part, $frac-part, $exp-part-negate, $exp-part) is export { + my $exp = str2num-int($exp-part); + $exp = -$exp if $exp-part-negate; + my $result = (str2num-int($int-part) + str2num-int($frac-part) / str2num-base($frac-part)) + * 10 ** $exp; + $result = -$result if $negate; + $result; + } }