diff --git a/lib/Minilisp.pm b/lib/Minilisp.pm index 4186e56..bcc7076 100644 --- a/lib/Minilisp.pm +++ b/lib/Minilisp.pm @@ -1150,6 +1150,47 @@ sub macro_dotimes { } $macros{dotimes} = \¯o_dotimes; +sub macro_dolist { + my $ts = shift; + + slurp_token($ts, LPAREN, "Expected ( after dolist"); + + my $var = slurp_token($ts, IDENT, "Expected identifier for var in dolist")->{value}; + + my $list_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 list-form or result-form in dolist"); + + my $body = macro_progn($ts); + + return create_block( + "nil", + sub { + my $octx = shift; + + my $lst = $list_expr->($octx); + + die "Expected list in dolist" + unless ref($lst) eq "ARRAY"; + + my $ictx = ctx_create($octx); + + foreach my $e (@$lst) + { + ctx_set($ictx, $var, $e); + $body->($ictx); + } + + ctx_set($ictx, $var, undef); + return $result_expr->($ictx); + } + ); +} +$macros{dolist} = \¯o_dolist; + sub compile { my ($term) = @_; my @tokens = tokenize($term); diff --git a/t/dolist.t b/t/dolist.t new file mode 100644 index 0000000..bd41077 --- /dev/null +++ b/t/dolist.t @@ -0,0 +1,31 @@ +(plan 5) + +(expect "dolist - body is evaluated with every element" + (let ((lst (list 1 2 5 'cool 'list 'bro nil)) + (lst-expected (list nil 'bro 'list 'cool 5 2 1)) + (lst-actual (list))) + (dolist (it lst) + (set lst-actual (cons it lst-actual))) + (equal lst-expected lst-actual))) + +(expect "dolist - body is not evaluated if list is empty" + (equal 'ok + (catch 'test + (dolist (e (list)) + (throw 'test 'fail)) + 'ok))) + +(expect "dolist - result form is evaluated" + (equal 'ok + (dolist (e (list 1) 'ok)))) + +(expect "dolist - returns nil if no result form" + (null (dolist (e (list 1))))) + +(expect "dolist - var is bound to nil during result form" + (equal 'ok + (catch 'test + (dolist (e (list 'fail) + (unless (null e) + (throw 'test 'fail)))) + 'ok)))