toke.c
/*
 * Perl_madlex
 * The intent of this yylex wrapper is to minimize the changes to the
 * tokener when we aren't interested in collecting madprops.  It remains
 * to be seen how successful this strategy will be...
 */
Perl_madlex
The intent of this yylex wrapper is to minimize the changes to the
tokener when we aren't interested in collecting madprops.  It remains
to be seen how successful this strategy will be
Perl_madlex The intent of this yylex wrapper is to minimize the changes to the tokener when we aren ' t interested in collecting madprops . It remains to be seen how successful this strategy will be
int
Perl_madlex(pTHX)
{
    int optype;
    char *s = PL_bufptr;
    PL_thiswhite = 0;
    PL_thismad = 0;
    if (PL_lex_state != LEX_KNOWNEXT && PL_pending_ident)
        return S_pending_ident(aTHX);
    if (!PL_lasttoke && PL_nextwhite) {
	PL_thiswhite = PL_nextwhite;
	PL_nextwhite = 0;
    }
    PL_realtokenstart = -1;
    PL_thistoken = 0;
    optype = yylex();
    s = PL_bufptr;
    assert(PL_curforce < 0);
    if (!PL_thismad || PL_thismad->mad_key == '^') {	
	if (!PL_thistoken) {
	    if (PL_realtokenstart < 0 || !CopLINE(PL_curcop))
		PL_thistoken = newSVpvs("");
	    else {
		char * const tstart = SvPVX(PL_linestr) + PL_realtokenstart;
		PL_thistoken = newSVpvn(tstart, s - tstart);
	    }
	}
	if (PL_thismad)	
	    CURMAD('X', PL_thistoken);
    }
    if (optype == ')' && PL_endwhite) {
	CURMAD('X', PL_endwhite);
    }
    if (!PL_thismad) {
	if (!PL_thiswhite && !PL_endwhite && !optype) {
	    sv_free(PL_thistoken);
	    PL_thistoken = 0;
	    return 0;
	}
	if (optype == ';' && !PL_rsfp && !PL_parser->filtered) {
	    PL_nextwhite = PL_thiswhite;
	    PL_thiswhite = 0;
	}
	else if (PL_thisopen) {
	    CURMAD('q', PL_thisopen);
	    if (PL_thistoken)
		sv_free(PL_thistoken);
	    PL_thistoken = 0;
	}
	else {
	    CURMAD('X', PL_thistoken);
	}
	if (PL_thiswhite) {
	    CURMAD('_', PL_thiswhite);
	}
	if (PL_thisstuff) {
	    CURMAD('=', PL_thisstuff);
	}
	if (PL_thisclose) {
	    CURMAD('Q', PL_thisclose);
	}
    }
    switch (optype) {
    case WORD:
    case METHOD:
    case FUNCMETH:
    case THING:
    case PMFUNC:
    case PRIVATEREF:
    case FUNC0SUB:
    case UNIOPSUB:
    case LSTOPSUB:
    case LABEL:
	if (pl_yylval.opval)
	    append_madprops(PL_thismad, pl_yylval.opval, 0);
	PL_thismad = 0;
	return optype;
    case 0:
	optype = PEG;
	if (PL_endwhite) {
	    addmad(newMADsv('p', PL_endwhite), &PL_thismad, 0);
	    PL_endwhite = 0;
	}
	break;
    case ']':
    case '}':
	if (PL_faketokens)
	    break;
	if (PL_lex_brackets == 1 &&
	    ((expectation)PL_lex_brackstack[0] & XFAKEBRACK))
	{
	    s = PL_bufptr;
	    while (s < PL_bufend && (*s == ' ' || *s == '\t'))
		s++;
	    if (*s == '}') {
		PL_thiswhite = newSVpvn(PL_bufptr, ++s - PL_bufptr);
		addmad(newMADsv('#', PL_thiswhite), &PL_thismad, 0);
		PL_thiswhite = 0;
		PL_bufptr = s - 1;
		break;	
	    }
	    else
		s = PL_bufptr;
	}
	if (optype == ']')
	    break;
    case ';':
	if (PL_faketokens)
	    break;
	if (PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == optype) {
	    s = PL_bufptr;
	    while (s < PL_bufend && (*s == ' ' || *s == '\t'))
		s++;
	    if (*s == '\n' || *s == '#') {
		while (s < PL_bufend && *s != '\n')
		    s++;
		if (s < PL_bufend)
		    s++;
		PL_thiswhite = newSVpvn(PL_bufptr, s - PL_bufptr);
		addmad(newMADsv('#', PL_thiswhite), &PL_thismad, 0);
		PL_thiswhite = 0;
		PL_bufptr = s;
	    }
	}
	break;
    default:
	break;
    }
    pl_yylval.tkval = newTOKEN(optype, pl_yylval, PL_thismad);
    PL_thismad = 0;
    return optype;
}
int Perl_madlex ( pTHX ) { int optype ; char * s = PL_bufptr ; PL_thiswhite = 0 ; PL_thismad = 0 ; if ( PL_lex_state != LEX_KNOWNEXT && PL_pending_ident ) return S_pending_ident ( aTHX ) ; if ( ! PL_lasttoke && PL_nextwhite ) { PL_thiswhite = PL_nextwhite ; PL_nextwhite = 0 ; } PL_realtokenstart = -1 ; PL_thistoken = 0 ; optype = yylex ( ) ; s = PL_bufptr ; assert ( PL_curforce < 0 ) ; if ( ! PL_thismad || PL_thismad -> mad_key == ' ' ) { if ( ! PL_thistoken ) { if ( PL_realtokenstart < 0 || ! CopLINE ( PL_curcop ) ) PL_thistoken = newSVpvs ( " " ) ; else { char * const tstart = SvPVX ( PL_linestr ) + PL_realtokenstart ; PL_thistoken = newSVpvn ( tstart , s - tstart ) ; } } if ( PL_thismad ) CURMAD ( ' ' , PL_thistoken ) ; } if ( optype == ' ' && PL_endwhite ) { CURMAD ( ' ' , PL_endwhite ) ; } if ( ! PL_thismad ) { if ( ! PL_thiswhite && ! PL_endwhite && ! optype ) { sv_free ( PL_thistoken ) ; PL_thistoken = 0 ; return 0 ; } if ( optype == ' ' && ! PL_rsfp && ! PL_parser -> filtered ) { PL_nextwhite = PL_thiswhite ; PL_thiswhite = 0 ; } else if ( PL_thisopen ) { CURMAD ( ' ' , PL_thisopen ) ; if ( PL_thistoken ) sv_free ( PL_thistoken ) ; PL_thistoken = 0 ; } else { CURMAD ( ' ' , PL_thistoken ) ; } if ( PL_thiswhite ) { CURMAD ( ' ' , PL_thiswhite ) ; } if ( PL_thisstuff ) { CURMAD ( ' ' , PL_thisstuff ) ; } if ( PL_thisclose ) { CURMAD ( ' ' , PL_thisclose ) ; } } switch ( optype ) { case WORD : case METHOD : case FUNCMETH : case THING : case PMFUNC : case PRIVATEREF : case FUNC0SUB : case UNIOPSUB : case LSTOPSUB : case LABEL : if ( pl_yylval . opval ) append_madprops ( PL_thismad , pl_yylval . opval , 0 ) ; PL_thismad = 0 ; return optype ; case 0 : optype = PEG ; if ( PL_endwhite ) { addmad ( newMADsv ( ' ' , PL_endwhite ) , & PL_thismad , 0 ) ; PL_endwhite = 0 ; } break ; case ' ' : case ' ' : if ( PL_faketokens ) break ; if ( PL_lex_brackets == 1 && ( ( expectation ) PL_lex_brackstack [ 0 ] & XFAKEBRACK ) ) { s = PL_bufptr ; while ( s < PL_bufend && ( * s == ' ' || * s == ' \t ' ) ) s ++ ; if ( * s == ' ' ) { PL_thiswhite = newSVpvn ( PL_bufptr , ++ s - PL_bufptr ) ; addmad ( newMADsv ( ' ' , PL_thiswhite ) , & PL_thismad , 0 ) ; PL_thiswhite = 0 ; PL_bufptr = s - 1 ; break ; } else s = PL_bufptr ; } if ( optype == ' ' ) break ; case ' ' : if ( PL_faketokens ) break ; if ( PL_bufptr > PL_oldbufptr && PL_bufptr [ -1 ] == optype ) { s = PL_bufptr ; while ( s < PL_bufend && ( * s == ' ' || * s == ' \t ' ) ) s ++ ; if ( * s == ' \n ' || * s == ' ' ) { while ( s < PL_bufend && * s != ' \n ' ) s ++ ; if ( s < PL_bufend ) s ++ ; PL_thiswhite = newSVpvn ( PL_bufptr , s - PL_bufptr ) ; addmad ( newMADsv ( ' ' , PL_thiswhite ) , & PL_thismad , 0 ) ; PL_thiswhite = 0 ; PL_bufptr = s ; } } break ; default : break ; } pl_yylval . tkval = newTOKEN ( optype , pl_yylval , PL_thismad ) ; PL_thismad = 0 ; return optype ; }
Perl_madlex
 The intent of this yylex wrapper is to minimize the changes to the
 tokener when we aren't interested in collecting madprops.
Perl_madlex The intent of this yylex wrapper is to minimize the changes to the tokener when we aren ' t interested in collecting madprops .
/* make sure PL_thiswhite is initialized */ /* just do what yylex would do on pending identifier; leave PL_thiswhite alone */ /* previous token ate up our whitespace? */ /* isolate the token, and figure out where it is without whitespace */ /* not forced already? */ /* install head */ /* last whitespace of a sublex? */ /* if no whitespace and we're at EOF, bail.  Otherwise fake EOF below. */ /* put off final whitespace till peg */ /* Store actual token text as madprop X */ /* add preceding whitespace as madprop _ */ /* add quoted material as madprop = */ /* add terminating quote as madprop Q */ /* special processing based on optype */ /* opval doesn't need a TOKEN since it can already store mp */ /* fake EOF */ /* remember any fake bracket that lexer is about to discard */ /* don't bother looking for trailing comment */ /* FALLTHROUGH */ /* attach a trailing comment to its statement instead of next token */ /* ival */ /* Create new token struct.  Note: opvals return early above. */