/
pirt.t
107 lines (88 loc) · 2.94 KB
/
pirt.t
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
use QAST;
plan(5);
sub is_pirt_result($producer, $expected, $desc) {
my $pirt := $producer();
my $pir := $pirt.pir();
#say($pir);
my $pbc := QAST::Compiler.evalpmc($pir).main_sub();
ok($pbc() eq $expected, $desc);
}
is_pirt_result({
my $ops := PIRT::Ops.new();
$ops.push_pirop('return', '"lol"');
my $sub := PIRT::Sub.new();
$sub.push($ops);
$sub
},
"lol",
"simple sub that returns a literal string");
is_pirt_result({
my $ops1 := PIRT::Ops.new(:result('"omg"'));
my $ops2 := PIRT::Ops.new();
$ops2.push($ops1);
$ops2.push_pirop('set', '$S0', $ops1);
$ops2.push_pirop('return', '$S0');
my $sub := PIRT::Sub.new();
$sub.push($ops2);
$sub
},
"omg",
"using Ops nodes inside Ops nodes");
is_pirt_result({
my $label := PIRT::Label.new(:name('lbl'));
my $ops := PIRT::Ops.new();
$ops.push_pirop('goto', $label);
$ops.push_pirop('return', '"OOPS"');
$ops.push($label);
$ops.push_pirop('return', '"c\'est l\'awesome"');
my $sub := PIRT::Sub.new();
$sub.push($ops);
$sub
},
"c'est l'awesome",
"Basic use of labels");
is_pirt_result({
# Create a nested sub.
my $n_ops := PIRT::Ops.new();
$n_ops.push_pirop('return', '"nested sub"');
my $n_sub := PIRT::Sub.new();
$n_sub.push($n_ops);
$n_sub.subid('n_sub');
# Create the outer sub that looks it up and calls it.
my $ops := PIRT::Ops.new();
$ops.push($n_sub);
$ops.push_pirop(".const 'Sub' \$P0 = 'n_sub'");
$ops.push_pirop('call', '$P0', :result('$S0'));
$ops.push_pirop('concat', '$S1', '$S0', '" outer sub"');
$ops.push_pirop('return', '$S1');
my $sub := PIRT::Sub.new();
$sub.push($ops);
$sub
},
"nested sub outer sub",
"Calling subs");
is_pirt_result({
# Create a nested sub that looks up a lexical.
my $n_ops := PIRT::Ops.new();
$n_ops.push_pirop('find_lex', '$P0', '"$foo"');
$n_ops.push_pirop('return', '$P0');
my $n_sub := PIRT::Sub.new();
$n_sub.push($n_ops);
$n_sub.subid('n_sub');
$n_sub.pirflags(':outer("o_sub")');
# Create the outer sub that looks it up and calls it.
my $ops := PIRT::Ops.new();
$ops.push($n_sub);
$ops.push_pirop('box', '$P1', '"lexicals work!"');
$ops.push_pirop('.lex', '"$foo"', '$P1');
$ops.push_pirop(".const 'Sub' \$P0 = 'n_sub'");
$ops.push_pirop('capture_lex', '$P0');
$ops.push_pirop('call', '$P0', :result('$S0'));
$ops.push_pirop('return', '$S0');
my $sub := PIRT::Sub.new();
$sub.push($ops);
$sub.subid('o_sub');
$sub
},
'lexicals work!',
"pirflags emitted correctly");