/
Sig.pm
100 lines (82 loc) · 2.59 KB
/
Sig.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
use strict;
use warnings;
use 5.010;
{
package Sig::Target;
use Moose;
has slot => (is => 'ro', isa => 'Maybe[Str]', required => 1);
has list => (is => 'ro', isa => 'Bool', default => 0);
sub used_slots {
my $self = shift;
if ($self->slot) { [ $self->slot, $self->list ] } else { () }
}
sub binder {
my ($self, $get) = @_;
if ($self->slot) {
# TODO: implement ro, etc
CgOp::bind(0, CgOp::scopedlex($self->slot), $get);
} else {
CgOp::noop;
}
}
__PACKAGE__->meta->make_immutable;
no Moose;
}
{
package Sig::Parameter;
use Moose;
has target => (is => 'ro', isa => 'Sig::Target', required => 1,
handles => [ 'used_slots' ]);
has slurpy => (is => 'ro', isa => 'Bool', default => 0);
sub binder {
my ($self, $ixp) = @_;
if ($self->slurpy) {
$self->target->binder(
CgOp::let(CgOp::rawnew('DynObject', CgOp::getfield('klass',
CgOp::cast('DynObject', CgOp::fetch(CgOp::scopedlex('List'))))), sub {
my $do = shift;
CgOp::prog(
CgOp::setindex('flat', CgOp::getfield('slots', $do),
CgOp::box('Bool', CgOp::bool(1))),
CgOp::setindex('items', CgOp::getfield('slots', $do),
CgOp::box('LLArray', CgOp::rawnew('List<Variable>'))),
CgOp::setindex('rest', CgOp::getfield('slots', $do),
CgOp::box('LLArray',
CgOp::rawscall('Kernel.SlurpyHelper',
CgOp::int($$ixp)))),
CgOp::newscalar($do))}));
} else {
$self->target->binder(CgOp::pos($$ixp++));
}
}
__PACKAGE__->meta->make_immutable;
no Moose;
}
{
package Sig;
use Moose;
has params => (isa => 'ArrayRef[Sig::Parameter]', is => 'ro', required => 1);
sub for_method {
my $self = shift;
my $sp = Sig::Parameter->new(target =>
Sig::Target->new(slot => 'self'));
Sig->new(params => [ $sp, @{ $self->params } ]);
}
sub used_slots {
my $self = shift;
map { $_->used_slots } @{ $self->params };
}
sub binder {
my ($self) = @_;
# TODO: Error checking.
my $ix = 0;
my @p;
for (@{ $self->params }) {
push @p, $_->binder(\$ix);
}
CgOp::prog(@p);
}
__PACKAGE__->meta->make_immutable;
no Moose;
}
1;