diff --git a/lib/Minilisp.pm b/lib/Minilisp.pm index 6e360bf..2ed7772 100644 --- a/lib/Minilisp.pm +++ b/lib/Minilisp.pm @@ -474,6 +474,11 @@ sub slurp_token { return $tok; } +sub peek_token { + my ($ts, $type) = @_; + return $ts->[0]->{type} == $type; +} + sub parser_list { my $ts = shift; @@ -826,6 +831,91 @@ sub macro_or { } $macros{or} = \¯o_or; +sub macro_do { + my $ts = shift; + + slurp_token($ts, LPAREN, "Expected ( after do"); + + my @vars; + + while(!peek_token($ts, RPAREN)) + { + my $name = undef; + my $init = undef; + my $step = undef; + + if (peek_token($ts, IDENT)) + { + $name = slurp_token($ts,IDENT)->{value}; + } + else + { + slurp_token($ts, LPAREN, "Expected either identifier or ( in var list"); + + $name = slurp_token($ts, IDENT)->{value}; + + if ( !peek_token($ts, RPAREN) ) + { + $init = parser_expr($ts); + + if ( !peek_token($ts, RPAREN) ) + { + $step = parser_expr($ts); + } + } + + slurp_token($ts, RPAREN, "Expected ) after var"); + } + + push @vars, { + name => $name, + init => $init, + step => $step, + }; + } + + slurp_token($ts, RPAREN, "Expected ) after var list"); + + slurp_token($ts, LPAREN, "Expected ( before end-test-form"); + + my $end_test_form = parser_expr($ts); + + my $result_form = macro_progn($ts); + + slurp_token($ts, RPAREN, "Expected ) after resultform"); + + my $body = macro_progn($ts); + + return sub { + my $octx = shift; + my $ictx = ctx_create($octx); + + foreach my $var (@vars) + { + my $val = undef; + $val = $var->{init}->($octx) if defined $var->{init}; + ctx_set($ictx, $var->{name}, $val); + } + + while ( !from_lisp_bool($end_test_form->($ictx)) ) + { + $body->($ictx); + + my %steps; + foreach my $var (@vars) + { + next unless defined $var->{step}; + $steps{$var->{name}} = $var->{step}->($ictx); + } + + ctx_set($ictx, $_, $steps{$_}) foreach (keys %steps); + } + + return $result_form->($ictx); + } +} +$macros{do} = \¯o_do; + sub compile { my ($term) = @_; my @tokens = tokenize($term); diff --git a/t/do.t b/t/do.t new file mode 100644 index 0000000..e9bad3c --- /dev/null +++ b/t/do.t @@ -0,0 +1,13 @@ +(expect "do - simple example" + (equal (do ((n 1)) (t n)) 1)) + +(defun range (start end) + (do ((i (- end 1) (- i 1)) + (lst (list) (cons i lst))) + ((< i start) lst))) + +(expect "do - range function" + (equal (let ((lst (range 1 4))) + (comment lst) + lst) + (list 1 2 3)))