Implement dotimes and add tests
This commit is contained in:
parent
70ce321517
commit
ac1f8aef03
2 changed files with 68 additions and 0 deletions
|
@ -1112,6 +1112,44 @@ sub macro_throw {
|
||||||
}
|
}
|
||||||
$macros{throw} = \¯o_throw;
|
$macros{throw} = \¯o_throw;
|
||||||
|
|
||||||
|
sub macro_dotimes {
|
||||||
|
my $ts = shift;
|
||||||
|
|
||||||
|
slurp_token($ts, LPAREN, "Expected ( after dotimes");
|
||||||
|
|
||||||
|
my $var = slurp_token($ts, IDENT, "Expected identifier for var in dotimes")->{value};
|
||||||
|
|
||||||
|
my $count_expr = parser_expr($ts);
|
||||||
|
|
||||||
|
my $result_expr = sub { undef };
|
||||||
|
$result_expr = parser_expr($ts) unless peek_token($ts, RPAREN);
|
||||||
|
|
||||||
|
slurp_token($ts, RPAREN, "Expected ) after count-form or result-form in dotimes");
|
||||||
|
|
||||||
|
my $body = macro_progn($ts);
|
||||||
|
|
||||||
|
return create_block(
|
||||||
|
"nil",
|
||||||
|
sub {
|
||||||
|
my $octx = shift;
|
||||||
|
|
||||||
|
my $n = $count_expr->($octx);
|
||||||
|
|
||||||
|
my $ictx = ctx_create($octx);
|
||||||
|
|
||||||
|
for(my $i = 0; $i < $n; $i++)
|
||||||
|
{
|
||||||
|
ctx_set($ictx, $var, $i);
|
||||||
|
$body->($ictx);
|
||||||
|
}
|
||||||
|
|
||||||
|
ctx_set($ictx, $var, $n);
|
||||||
|
return $result_expr->($ictx);
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}
|
||||||
|
$macros{dotimes} = \¯o_dotimes;
|
||||||
|
|
||||||
sub compile {
|
sub compile {
|
||||||
my ($term) = @_;
|
my ($term) = @_;
|
||||||
my @tokens = tokenize($term);
|
my @tokens = tokenize($term);
|
||||||
|
|
30
t/dotimes.t
Normal file
30
t/dotimes.t
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
(plan 5)
|
||||||
|
|
||||||
|
(expect "dotimes - executes body n times"
|
||||||
|
(let ((pings 0))
|
||||||
|
(dotimes (i 5)
|
||||||
|
(set pings (+ 1 pings)))
|
||||||
|
(equal pings 5)))
|
||||||
|
|
||||||
|
(expect "dotimes - evaluates result form"
|
||||||
|
(equal 6
|
||||||
|
(dotimes (i 6 i))))
|
||||||
|
|
||||||
|
(expect "dotimes - implicit block nil"
|
||||||
|
(equal 'ok
|
||||||
|
(dotimes (i 6)
|
||||||
|
(return 'ok))))
|
||||||
|
|
||||||
|
(expect "dotimes - body is not evaluated if count is 0"
|
||||||
|
(equal 'ok
|
||||||
|
(catch 'test
|
||||||
|
(dotimes (i 0)
|
||||||
|
(throw 'test 'fail))
|
||||||
|
'ok)))
|
||||||
|
|
||||||
|
(expect "dotimes - body is not evaluated if count is negative"
|
||||||
|
(equal 'ok
|
||||||
|
(catch 'test
|
||||||
|
(dotimes (i -3)
|
||||||
|
(throw 'test 'fail))
|
||||||
|
'ok)))
|
Loading…
Reference in a new issue