Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: ZA
Fetching contributors…

Cannot retrieve contributors at this time

225 lines (203 sloc) 7.505 kb
our $?TABSTOP = 8;
augment class Str does Stringy {
multi method Bool { ?(pir::istrue__IP(self)); }
method Str() { self }
my @KNOWN_ENCODINGS = <utf-8 iso-8859-1 ascii>;
# XXX: We have no $?ENC or $?NF compile-time constants yet.
multi method encode($encoding is copy = 'utf-8', $nf = '') {
if $encoding eq 'latin-1' {
$encoding = 'iso-8859-1';
}
die "Unknown encoding $encoding"
unless $encoding.lc eq any @KNOWN_ENCODINGS;
$encoding .= lc;
my @bytes = Q:PIR {
.local int byte
.local pmc bytebuffer, it, result
$P0 = find_lex 'self'
$S0 = $P0
$P1 = find_lex '$encoding'
$S1 = $P1
if $S1 == 'ascii' goto transcode_ascii
if $S1 == 'iso-8859-1' goto transcode_iso_8859_1
# NOTE: There's an assumption here, that all strings coming in
# from the rest of Rakudo are always in UTF-8 form. Don't
# know if this assumption always holds; to be on the safe
# side, we might transcode even to UTF-8.
goto finished_transcoding
transcode_ascii:
$I0 = find_encoding 'ascii'
$S0 = trans_encoding $S0, $I0
goto finished_transcoding
transcode_iso_8859_1:
$I0 = find_encoding 'iso-8859-1'
$S0 = trans_encoding $S0, $I0
finished_transcoding:
bytebuffer = new ['ByteBuffer']
bytebuffer = $S0
result = new ['Parcel']
it = iter bytebuffer
bytes_loop:
unless it goto done
byte = shift it
push result, byte
goto bytes_loop
done:
%r = result
};
return Buf.new(@bytes);
}
# Zero indent does nothing
multi method indent($steps as Int where { $_ == 0 }) {
self;
}
# Positive indent does indent
multi method indent($steps as Int where { $_ > 0 }) {
# We want to keep trailing \n so we have to .comb explicitly instead of .lines
return self.comb(/:r ^^ \N* \n?/).map({
given $_ {
# Use the existing space character if they're all the same
# (but tabs are done slightly differently)
when /^(\t+) ([ \S .* | $ ])/ {
$0 ~ "\t" x ($steps div $?TABSTOP) ~
' ' x ($steps mod $?TABSTOP) ~ $1
}
when /^(\h) $0* [ \S | $ ]/ {
$0 x $steps ~ $_
}
# Otherwise we just insert spaces after the existing leading space
default {
($_ ~~ /^(\h*) (.*)$/).join(' ' x $steps)
}
}
}).join;
}
# Negative values and Whatever-* do outdent
multi method indent($steps) {
# Loop through all lines to get as much info out of them as possible
my @lines = self.comb(/:r ^^ \N* \n?/).map({
# Split the line into indent and content
my ($indent, $rest) = @($_ ~~ /^(\h*) (.*)$/);
# Split the indent into characters and annotate them
# with their visual size
my $indent-size = 0;
my @indent-chars = $indent.comb.map(-> $char {
my $width = $char eq "\t"
?? $?TABSTOP - ($indent-size mod $?TABSTOP)
!! 1;
$indent-size += $width;
$char => $width;
});
{ :$indent-size, :@indent-chars, :$rest };
});
# Figure out the amount * should outdent by, we also use this for warnings
my $common-prefix = [min] @lines.map({ $_<indent-size> });
# Set the actual outdent amount here
my Int $outdent = $steps ~~ Whatever ?? $common-prefix
!! -$steps;
warn sprintf('Asked to remove %d spaces, ' ~
'but the shortest indent is %d spaces',
$outdent, $common-prefix) if $outdent > $common-prefix;
# Work backwards from the right end of the indent whitespace, removing
# array elements up to # (or over, in the case of tab-explosion)
# the specified outdent amount.
@lines.map({
my $pos = 0;
while $_<indent-chars> and $pos < $outdent {
$pos += $_<indent-chars>.pop.value;
}
$_<indent-chars>».key.join ~ ' ' x ($pos - $outdent) ~ $_<rest>;
}).join;
}
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
};
}
sub chop-trailing-zeros($i) {
Q:PIR {
.local int idx
$P0 = find_lex '$i'
$S0 = $P0
idx = length $S0
repl_loop:
if idx == 0 goto done
dec idx
$S1 = substr $S0, idx, 1
if $S1 == '0' goto repl_loop
done:
inc idx
$S0 = substr $S0, 0, idx
$P0 = $S0
%r = $P0
}
}
our sub str2num-rat($negate, $int-part, $frac-part is copy) is export {
$frac-part = chop-trailing-zeros($frac-part);
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;
}
}
Jump to Line
Something went wrong with that request. Please try again.