diff --git a/src/Raku/Grammar.nqp b/src/Raku/Grammar.nqp index 85e2942b20d..102fcbd616e 100644 --- a/src/Raku/Grammar.nqp +++ b/src/Raku/Grammar.nqp @@ -1103,8 +1103,9 @@ grammar Raku::Grammar is HLL::Grammar does Raku::Common { token statement-prefix:sym { <.kok> } token statement-prefix:sym { <.kok> } token statement-prefix:sym { <.kok> } - token statement-prefix:sym { <.kok> } token statement-prefix:sym { <.kok> } + token statement-prefix:sym { <.kok> } + token statement-prefix:sym { <.kok> } # Prefixes that work differently on for loops token statement-prefix:sym { <.kok> } diff --git a/src/Raku/ast/statementprefixes.rakumod b/src/Raku/ast/statementprefixes.rakumod index e45bf9a97af..649e4d10e81 100644 --- a/src/Raku/ast/statementprefixes.rakumod +++ b/src/Raku/ast/statementprefixes.rakumod @@ -360,6 +360,52 @@ class RakuAST::StatementPrefix::Start } } +# The `supply` statement prefix. +class RakuAST::StatementPrefix::Supply + is RakuAST::StatementPrefix::Thunky + is RakuAST::SinkPropagator + is RakuAST::ImplicitBlockSemanticsProvider +{ + method type() { "supply" } + + method propagate-sink(Bool $is-sunk) { + self.blorst.apply-sink(False); + } + + method apply-implicit-block-semantics() { + self.blorst.set-fresh-variables(:match, :exception) + if nqp::istype(self.blorst, RakuAST::Block); + } + + method IMPL-QAST-FORM-BLOCK( + RakuAST::IMPL::QASTContext $context, + str :$blocktype, + RakuAST::Expression :$expression + ) { + if nqp::istype(self.blorst, RakuAST::Block) { + self.blorst.IMPL-QAST-FORM-BLOCK($context, :$blocktype, :$expression) + } + else { + my $block := QAST::Block.new( + :blocktype('declaration_static'), + QAST::Stmts.new( + RakuAST::VarDeclaration::Implicit::Special.new(:name('$/')).IMPL-QAST-DECL($context), + RakuAST::VarDeclaration::Implicit::Special.new(:name('$!')).IMPL-QAST-DECL($context), + self.blorst.IMPL-TO-QAST($context) + )); + $block.arity(0); + $block + } + } + + method IMPL-EXPR-QAST(RakuAST::IMPL::QASTContext $context) { + QAST::Op.new(:op, + :name<&SUPPLY>, + self.IMPL-CLOSURE-QAST($context) + ) + } +} + # Done by all phasers. Serves as little more than a marker for phasers, for # easing locating them all. class RakuAST::StatementPrefix::Phaser diff --git a/t/12-rakuast/statement-prefix.rakutest b/t/12-rakuast/statement-prefix.rakutest index 6fe59edc5b0..1a617d57369 100644 --- a/t/12-rakuast/statement-prefix.rakutest +++ b/t/12-rakuast/statement-prefix.rakutest @@ -1,7 +1,7 @@ use v6.e.PREVIEW; use Test; -plan 14; +plan 16; my $ast; my $deparsed; @@ -461,4 +461,70 @@ subtest 'A start has a fresh $!' => { } } +subtest 'supply statement prefix with expression evaluates to Supply' => { + # supply emit(42) + ast RakuAST::StatementPrefix::Supply.new( + RakuAST::Statement::Expression.new( + expression => RakuAST::Call::Name.new( + name => RakuAST::Name.from-identifier("emit"), + args => RakuAST::ArgList.new( + RakuAST::IntLiteral.new(42) + ) + ) + ) + ); + + # must be this number of tests + plan 7; + + is-deeply $deparsed, 'supply emit(42)', 'deparse'; + + for + 'AST', EVAL($ast), + 'Str', EVAL($deparsed), + 'Raku', EVAL(EVAL $raku) + -> $type, $supply { + isa-ok $supply, Supply, $type; + $supply.tap({ is $_, 42, 'emitted value ok' }); + } +} + +subtest 'supply statement prefix with block evaluates to Supply' => { + # supply { emit(42) } + ast RakuAST::StatementPrefix::Supply.new( + RakuAST::Block.new( + body => RakuAST::Blockoid.new( + RakuAST::StatementList.new( + RakuAST::Statement::Expression.new( + expression => RakuAST::Call::Name.new( + name => RakuAST::Name.from-identifier("emit"), + args => RakuAST::ArgList.new( + RakuAST::IntLiteral.new(42) + ) + ) + ) + ) + ) + ) + ); + + # must be this number of tests + plan 7; + + is-deeply $deparsed, q:to/CODE/.chomp, 'deparse'; +supply { + emit(42) +} +CODE + + for + 'AST', EVAL($ast), + 'Str', EVAL($deparsed), + 'Raku', EVAL(EVAL $raku) + -> $type, $supply { + isa-ok $supply, Supply, $type; + $supply.tap({ is $_, 42, 'emitted value ok' }); + } +} + # vim: expandtab shiftwidth=4