/
Str.pm
110 lines (102 loc) · 3.27 KB
/
Str.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
augment class Str does Stringy {
multi method Bool { ?(pir::istrue__IP(self)); }
method Str() { self }
# CHEAT: this implementation is a bit of a cheat,
# but works fine for now.
multi method Int { (+self).Int; }
multi method Num { (+self).Num; }
# XXX: We have no $?ENC or $?NF compile-time constants yet.
multi method encode($encoding = 'UTF-8', $nf = '') {
my @bytes = Q:PIR {
.local int byte
.local pmc bytebuffer, it, result
$P0 = find_lex 'self'
$S0 = $P0
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);
}
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;
}
}