-
Notifications
You must be signed in to change notification settings - Fork 15
/
OpHelpers.pm6
65 lines (56 loc) · 2.12 KB
/
OpHelpers.pm6
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
module OpHelpers;
sub mnode($M) is export {
$M.^isa(Match) ??
{ file => $*FILE<name>, line => $M.CURSOR.lineof($M.from), pos => $M.from } !!
{ file => $*FILE<name>, line => $M.lineof($M.pos), pos => $M.pos }
}
sub node($M) is export { { line => $M.CURSOR.lineof($M.pos) } }
sub mklet($value, $body) is export {
my $var = ::GLOBAL::NieczaActions.gensym;
::Op::Let.new(var => $var, to => $value,
in => $body(::Op::LetVar.new(name => $var)));
}
sub mkcall($/, $name, *@positionals) is export {
$/.CURSOR.mark_used($name);
$*CURLEX<!sub>.noninlinable if $name eq '&eval'; # HACK
::Op::CallSub.new(|node($/),
invocant => ::Op::Lexical.new(|node($/), :$name), :@positionals);
}
sub mklex($/, $name, *%_) is export {
$/.CURSOR.mark_used($name);
$*CURLEX<!sub>.noninlinable if $name eq '&eval'; # HACK
::Op::Lexical.new(|node($/), :$name, |%_);
}
sub mkbool($i) is export { ::Op::Lexical.new(name => $i ?? 'True' !! 'False') }
sub mktemptopic($/, $item, $expr) is export {
mklet(mklex($/, '$_'), -> $old_ {
::Op::StatementList.new(|node($/), children => [
::Op::LexicalBind.new(:name<$_>, rhs => $item),
mklet($expr, -> $result {
::Op::StatementList.new(children => [
::Op::LexicalBind.new(:name<$_>, rhs => $old_),
$result]) }) ]) });
}
sub mkstringycat($/, *@strings) is export {
my @a;
for @strings -> $s {
my $i = ($s !~~ ::GLOBAL::Op) ?? ::Op::StringLiteral.new(|node($/),
text => $s) !! $s;
# this *might* belong in an optimization pass
if @a && @a[*-1] ~~ ::Op::StringLiteral &&
$i ~~ ::Op::StringLiteral {
@a[*-1] = ::Op::StringLiteral.new(|node($/),
text => (@a[*-1].text ~ $i.text));
} else {
push @a, $i;
}
}
if @a == 0 {
return ::Op::StringLiteral.new(|node($/), text => "");
} elsif @a == 1 {
return (@a[0] ~~ ::Op::StringLiteral) ?? @a[0] !!
mkcall($/, '&prefix:<~>', @a[0]);
} else {
return mkcall($/, '&infix:<~>', @a);
}
}