Skip to content

Commit 544a992

Browse files
jnthnjnthn
committed
Add initial sketch of PIRT, which is to be a hopefully more memory efficient replacement for POST.
1 parent c6b0eee commit 544a992

File tree

3 files changed

+236
-0
lines changed

3 files changed

+236
-0
lines changed

‎src/QAST/PIRT.nqp‎

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
# PIRT is a very lightweight PIR tree representation. It does very little
2+
# really, besides being much more pleasant than working with strings directly
3+
# in QAST::Compiler. Since the mapping is pretty close, the nodes themselves
4+
# know how to become PIR.
5+
6+
class PIRT::Node {
7+
my %op_compilers := nqp::hash(
8+
'call', sub (@args) {
9+
nqp::die("NYI");
10+
},
11+
'callmethod', sub (@args) {
12+
nqp::die("NYI");
13+
},
14+
'return', sub (@args) {
15+
" .return (" ~ nqp::join(", ", @args) ~ ")"
16+
},
17+
'yield', sub (@args) {
18+
nqp::die("NYI");
19+
},
20+
'tailcall', sub (@args) {
21+
nqp::die("NYI");
22+
},
23+
'inline', sub (@args) {
24+
nqp::die("NYI");
25+
});
26+
27+
method children_pir(@children) {
28+
my @parts;
29+
for @children {
30+
if nqp::islist($_) {
31+
my $op_name := $_[0];
32+
my @op_args;
33+
my $i := 1;
34+
my $c := nqp::elems($_);
35+
my $arg;
36+
while $i < $c {
37+
$arg := $_[$i];
38+
if $arg ~~ PIRT::Node {
39+
nqp::push(@op_args, $arg.result);
40+
}
41+
else {
42+
nqp::push(@op_args, $arg);
43+
}
44+
$i := $i + 1;
45+
}
46+
if nqp::existskey(%op_compilers, $op_name) {
47+
nqp::push(@parts, %op_compilers{$op_name}(@op_args));
48+
}
49+
else {
50+
nqp::push(@parts, ' ' ~ $op_name ~ ' ' ~ nqp::join(", ", @op_args));
51+
}
52+
}
53+
elsif $_ ~~ PIRT::Sub {
54+
nqp::push(@*PIRT_BLOCKS, $_);
55+
}
56+
elsif $_ ~~ PIRT::Node {
57+
my $pir := $_.pir;
58+
nqp::push(@parts, $pir) unless $pir eq '';
59+
}
60+
else {
61+
nqp::die("Unexpected object in PIRT tree");
62+
}
63+
}
64+
nqp::join("\n", @parts)
65+
}
66+
}
67+
68+
class PIRT::Sub is PIRT::Node {
69+
has @!children;
70+
has @!nested_blocks;
71+
has str $!cached_pir;
72+
73+
method new() {
74+
my $obj := nqp::create(self);
75+
nqp::bindattr($obj, PIRT::Sub, '@!children', nqp::list());
76+
$obj
77+
}
78+
79+
method push($node) {
80+
nqp::push(@!children, $node);
81+
}
82+
83+
method push_pirop(*@opbits) {
84+
nqp::push(@!children, @opbits)
85+
}
86+
87+
method result() {
88+
nqp::die("Cannot use a PIRT::Sub in a context expecting a result");
89+
}
90+
91+
method close_sub() {
92+
my @parts;
93+
94+
# Sub prelude.
95+
nqp::push(@parts, ".sub ''");
96+
97+
# Compile sub contents, collecting any nested blocks.
98+
my @*PIRT_BLOCKS;
99+
nqp::push(@parts, self.children_pir(@!children));
100+
101+
# Sub postlude.
102+
nqp::push(@parts, ".end");
103+
104+
# Store the compiled PIR and collected inner blocks. Also, null out
105+
# the children array, to free up memory.
106+
$!cached_pir := nqp::join("\n", @parts);
107+
@!nested_blocks := @*PIRT_BLOCKS;
108+
}
109+
110+
method pir() {
111+
# If we don't already have the sub body, then close the sub now.
112+
unless $!cached_pir {
113+
self.close_sub();
114+
}
115+
116+
# Our PIR is ourselve plus the PIR of any nested blocks.
117+
my @parts := [$!cached_pir];
118+
for @!nested_blocks {
119+
nqp::push(@parts, $_.pir());
120+
}
121+
nqp::join("\n", @parts)
122+
}
123+
}
124+
125+
class PIRT::Ops is PIRT::Node {
126+
has @!children;
127+
has str $!result;
128+
129+
method new(:$result = '') {
130+
my $obj := nqp::create(self);
131+
nqp::bindattr($obj, PIRT::Ops, '@!children', nqp::list());
132+
nqp::bindattr_s($obj, PIRT::Ops, '$!result',
133+
$result ~~ PIRT::Node ?? $result.result !! $result);
134+
$obj
135+
}
136+
137+
method push($node) {
138+
nqp::push(@!children, $node)
139+
}
140+
141+
method push_pirop(*@opbits) {
142+
nqp::push(@!children, @opbits)
143+
}
144+
145+
method result(*@value) {
146+
if @value {
147+
$!result := @value[0] ~~ PIRT::Node ?? @value[0].result !! @value[0];
148+
}
149+
else {
150+
$!result
151+
}
152+
}
153+
154+
method pir() {
155+
self.children_pir(@!children)
156+
}
157+
}
158+
159+
class PIRT::Label is PIRT::Node {
160+
has str $!name;
161+
162+
method new(:$name!) {
163+
my $obj := nqp::create(self);
164+
nqp::bindattr_s($obj, PIRT::Label, '$!name', $name);
165+
$obj
166+
}
167+
168+
method name(*@value) {
169+
@value ?? ($!name := @value[0]) !! $!name
170+
}
171+
172+
method result() {
173+
$!name
174+
}
175+
176+
method pir() {
177+
' ' ~ $!name ~ ':'
178+
}
179+
}

‎t/qast/pirt.t‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
use QAST;
2+
3+
plan(3);
4+
5+
sub is_pirt_result($producer, $expected, $desc) {
6+
my $pirt := $producer();
7+
my $pir := $pirt.pir();
8+
#say($pir);
9+
my $pbc := QAST::Compiler.evalpmc($pir);
10+
ok($pbc() eq $expected, $desc);
11+
}
12+
13+
is_pirt_result({
14+
my $ops := PIRT::Ops.new();
15+
$ops.push_pirop('return', '"lol"');
16+
17+
my $sub := PIRT::Sub.new();
18+
$sub.push($ops);
19+
20+
$sub
21+
},
22+
"lol",
23+
"simple sub that returns a literal string");
24+
25+
is_pirt_result({
26+
my $ops1 := PIRT::Ops.new(:result('"omg"'));
27+
28+
my $ops2 := PIRT::Ops.new();
29+
$ops2.push($ops1);
30+
$ops2.push_pirop('set', '$S0', $ops1);
31+
$ops2.push_pirop('return', '$S0');
32+
33+
my $sub := PIRT::Sub.new();
34+
$sub.push($ops2);
35+
36+
$sub
37+
},
38+
"omg",
39+
"using Ops nodes inside Ops nodes");
40+
41+
is_pirt_result({
42+
my $label := PIRT::Label.new(:name('lbl'));
43+
44+
my $ops := PIRT::Ops.new();
45+
$ops.push_pirop('goto', $label);
46+
$ops.push_pirop('return', '"OOPS"');
47+
$ops.push($label);
48+
$ops.push_pirop('return', '"c\'est l\'awesome"');
49+
50+
my $sub := PIRT::Sub.new();
51+
$sub.push($ops);
52+
53+
$sub
54+
},
55+
"c'est l'awesome",
56+
"Basic use of labels");

‎tools/build/Makefile.in‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@ QAST_COMBINED = QAST.nqp
6969
QAST_PIR = QAST.pir
7070
QAST_PBC = QAST.pbc
7171
QAST_SOURCES = \
72+
src/QAST/PIRT.nqp \
7273
src/QAST/CompileTimeValue.nqp \
7374
src/QAST/SpecialArg.nqp \
7475
src/QAST/Node.nqp \

0 commit comments

Comments
 (0)