/
Function.pm
88 lines (71 loc) · 2.09 KB
/
Function.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
package PerLisp::Expr::Function;
use PerLisp::Mo qw(default required);
extends 'PerLisp::Expr';
has params => [];
has body => (required => 1);
has context => (required => 1);
sub eval {
my ($self, $context) = @_;
return $self;
}
sub to_string {
my $self = shift;
my $param_string = '(' . join(' ' => @{$self->params}) . ')';
my $body_string = $self->body->to_string;
return 'Function: ' . $param_string . ' -> ' . $body_string;
}
sub to_string_bound {
my ($self, $context) = @_;
my $param_string = '(' . join(' ' => @{$self->params}) . ')';
my $body_string = $self->body->to_string_bound($context);
return 'Function: ' . $param_string . ' -> ' . $body_string;
}
sub to_simple {
my $self = shift;
return {function => {
params => $self->params,
body => $self->body->to_simple,
context => $self->context->binds,
}};
}
sub to_simple_bound {
my ($self, $context) = @_;
return {function => {
params => $self->params,
body => $self->body->to_simple_bound($context),
context => $self->context->binds,
}};
}
sub apply {
my ($self, $context, $args) = @_;
# check arity: die if too many arguments
my $arity = @{$self->params};
die "can't apply: too many arguments.\n"
if @$args > $arity;
# try to match arguments and parameters to create local param bindings
my %binds;
my @params = @{$self->params};
foreach my $arg (@$args) {
# eval argument
my $val = $arg->eval($context);
# bind
my $param = shift @params;
$binds{$param} = $val;
}
# static scope
$context = $self->context;
# specialize context
my $local_context = $context->specialize(\%binds);
# remaining parameters? return a curried version
if (@params) {
return PerLisp::Expr::Function->new(
params => \@params,
body => $self->body,
context => $local_context,
);
}
# exact match: eval the body with new bindings
return $self->body->eval($local_context);
}
1;
__END__