forked from pmichaud/pmtcl
/
TclString.pm
88 lines (72 loc) · 2.37 KB
/
TclString.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
INIT {
pir::subclass__ps(pir::get_class__ps('String'), 'TclString');
my $tcl := pir::get_class__ps('TclString');
my $core := pir::get_class__ps('String');
pir::getinterp__p().hll_map($core, $tcl);
$tcl.add_vtable_override('get_bool', TclString::getBoolean);
$tcl.add_vtable_override('get_integer', TclString::getInteger);
}
module TclString {
method __dump($dumper, $label) {
pir::print('"');
$dumper.dumpStringEscaped( self, '"' );
pir::print('"');
}
method getInteger() { ## :is vtable
my $parse := Partcl::Grammar.parse(
self, :rule('integer'),
:actions(Partcl::Actions)
);
if ?$parse && $parse.chars() == pir::length__is(self) {
return $parse.ast();
} else {
error('expected integer but got "' ~ self ~ '"');
}
}
method getBoolean() { ## :is vtable
my $parse := Partcl::Grammar.parse(
self, :rule('term:sym<true>')
);
if ?$parse && $parse.chars() == pir::length__is(self) {
return 1;
}
$parse := Partcl::Grammar.parse(
self, :rule('term:sym<false>')
);
if ?$parse && $parse.chars() == pir::length__is(self) {
return 0;
}
$parse := Partcl::Grammar.parse(
self, :rule('integer'),
:actions(Partcl::Actions)
);
if ?$parse && $parse.chars() == pir::length__is(self) {
return ?$parse.ast();
}
error('expected boolean value but got "' ~ self ~ '"');
}
method getIndex($index) {
my $parse := Partcl::Grammar.parse(
$index, :rule('index'),
:actions(Partcl::Actions)
);
if ?$parse && $parse.chars() == pir::length__is($index) {
my @pos := $parse.ast();
my $len := pir::length__is(self);
my $loc := @pos[1];
if @pos[0] == 2 { # position relative from end.
$loc := $len - 1 + $loc;
}
return $loc;
} else {
error("bad index \"$index\": must be integer?[+-]integer? or end?[+-]integer?");
}
}
method getList() {
if self eq "" {
return pir::new__ps('TclList');
}
return Partcl::Grammar.parse(self, :rule<list>, :actions(Partcl::Actions) ).ast;
}
}
# vim: filetype=perl6: