Implement let*
This commit is contained in:
parent
f1e7da781b
commit
03dfa8f188
2 changed files with 63 additions and 42 deletions
|
@ -512,13 +512,15 @@ sub parser_call {
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub macro_let {
|
sub gen_macro_let {
|
||||||
|
my $incremental = shift;
|
||||||
|
return sub {
|
||||||
my $ts = shift;
|
my $ts = shift;
|
||||||
|
|
||||||
my $tok = shift @$ts;
|
my $tok = shift @$ts;
|
||||||
die "Expected ( after let" unless $tok->{type} == LPAREN;
|
die "Expected ( after let" unless $tok->{type} == LPAREN;
|
||||||
|
|
||||||
my $variables = {};
|
my @assignments;
|
||||||
|
|
||||||
while ($ts->[0]->{type} != RPAREN)
|
while ($ts->[0]->{type} != RPAREN)
|
||||||
{
|
{
|
||||||
|
@ -527,20 +529,23 @@ sub macro_let {
|
||||||
|
|
||||||
my $ident = parser_identifier($ts);
|
my $ident = parser_identifier($ts);
|
||||||
|
|
||||||
my $assignment;
|
my $expr;
|
||||||
if ($ts->[0]->{type} == RPAREN)
|
if ($ts->[0]->{type} == RPAREN)
|
||||||
{
|
{
|
||||||
$assignment = sub { return undef };
|
$expr = sub { return undef };
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
$assignment = parser_expr($ts)
|
$expr = parser_expr($ts)
|
||||||
}
|
}
|
||||||
|
|
||||||
$tok = shift @$ts;
|
$tok = shift @$ts;
|
||||||
die "Expected ) after parameter pair" unless $tok->{type} == RPAREN;
|
die "Expected ) after parameter pair" unless $tok->{type} == RPAREN;
|
||||||
|
|
||||||
$variables->{$ident} = $assignment;
|
push @assignments, {
|
||||||
|
ident => $ident,
|
||||||
|
expr => $expr
|
||||||
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN;
|
die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN;
|
||||||
|
@ -551,12 +556,14 @@ sub macro_let {
|
||||||
return sub {
|
return sub {
|
||||||
my $octx = shift;
|
my $octx = shift;
|
||||||
my $ictx = ctx_create($octx);
|
my $ictx = ctx_create($octx);
|
||||||
ctx_set($ictx, $_, $variables->{$_}->($octx)) foreach (keys %$variables);
|
ctx_set($ictx, $_->{ident}, $_->{expr}->($incremental ? $ictx : $octx)) foreach (@assignments);
|
||||||
|
|
||||||
return $inner->($ictx);
|
return $inner->($ictx);
|
||||||
}
|
};
|
||||||
|
};
|
||||||
}
|
}
|
||||||
$macros{let} = \¯o_let;
|
$macros{let} = gen_macro_let(0);
|
||||||
|
$macros{'let*'} = gen_macro_let(1);
|
||||||
|
|
||||||
sub macro_lambda {
|
sub macro_lambda {
|
||||||
my $ts = shift;
|
my $ts = shift;
|
||||||
|
|
14
t/let.t
14
t/let.t
|
@ -2,3 +2,17 @@
|
||||||
(expect "a is 5" (= a 5))
|
(expect "a is 5" (= a 5))
|
||||||
(expect "b is 6" (= b 6))
|
(expect "b is 6" (= b 6))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(let ((a 'top))
|
||||||
|
(let ((a 'shadow)
|
||||||
|
(b a))
|
||||||
|
(comment b)
|
||||||
|
(expect "let - non incremental context"
|
||||||
|
(equal b 'top))))
|
||||||
|
|
||||||
|
(let ((a 'top))
|
||||||
|
(let* ((a 'shadow)
|
||||||
|
(b a))
|
||||||
|
(comment b)
|
||||||
|
(expect "let* - Incremental context"
|
||||||
|
(equal b 'shadow))))
|
||||||
|
|
Loading…
Reference in a new issue