#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "wrap_keyword_plugin.inc.c"


STATIC SV *hint_key_sv;


#define is_syntax_enabled() SvTRUE( cop_hints_fetch_sv( PL_curcop, hint_key_sv, 0, 0 ) )


STATIC OP *parse_loop( pTHX ) {
#define parse_loop() parse_loop( aTHX )
   OP *exprop  = newSVOP( OP_CONST, 0, &PL_sv_yes );
   OP *blockop = parse_block( 0 );
   OP *loopop  = newWHILEOP( 0, 1, NULL, exprop, blockop, NULL, 0 );
   return loopop;
}


STATIC Perl_keyword_plugin_t next_keyword_plugin = NULL;
#define next_keyword_plugin( a, b, c ) next_keyword_plugin( aTHX_ a, b, c )


STATIC int my_keyword_plugin( pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr ) {
   if ( is_syntax_enabled() ) {
      if ( memEQs( keyword_ptr, keyword_len, "loop" ) ) {
         *op_ptr = parse_loop();
         return KEYWORD_PLUGIN_STMT;
      }
   }

   return next_keyword_plugin( keyword_ptr, keyword_len, op_ptr );
}


/* ======================================== */

MODULE = Syntax::Feature::Loop   PACKAGE = Syntax::Feature::Loop


void
hint_key()
   PPCODE:
      SvREFCNT_inc( hint_key_sv );
      XPUSHs( hint_key_sv );
      XSRETURN( 1 );


BOOT:
{
   wrap_keyword_plugin( my_keyword_plugin, &next_keyword_plugin );

   hint_key_sv = newSVpvs( "Syntax::Feature::Loop::loop" );
   SvREADONLY_on( hint_key_sv );
}