parser-compound.bas

Go to the documentation of this file.

'' compound statements (FOR, DO, WHILE, ...) top-level plus EXIT, END and CONTINUE parsing
''
'' chng: sep/2004 written [v1ctor]

#include once "fb.bi"
#include once "fbint.bi"
#include once "parser.bi"
#include once "ast.bi"
#include once "rtl.bi"

declare sub parserSelectStmtInit ( )
declare sub parserSelectStmtEnd	( )
declare sub parserSelConstStmtInit ( )
declare sub parserSelConstStmtEnd ( )
declare sub cCompoundEnd( )

sub parserCompoundStmtSetCtx( )
	parser.stmt.for = NULL
	parser.stmt.do	= NULL
	parser.stmt.while = NULL
	parser.stmt.select = NULL
	parser.stmt.proc = NULL
	parser.stmt.with.sym = NULL
end sub

sub parserCompoundStmtInit( )
	parserSelectStmtInit( )
	parserSelConstStmtInit( )
end sub

sub parserCompoundStmtEnd( )
	parserSelConstStmtEnd( )
	parserSelectStmtEnd( )
end sub

#macro CHECK_CODEMASK( for_tk, until_tk )
	if( cCompStmtIsAllowed( FB_CMPSTMT_MASK_CODE ) = FALSE ) then
		hSkipCompound( for_tk, until_tk )
		exit function
	end if
#endmacro

'':::::
''CompoundStmt	  =   IfStatement
''				  |   ForStatement
''	              |   DoStatement
''				  |   WhileStatement
''				  |   SelectStatement
''				  |   ExitStatement
''				  |   ContinueStatement
''				  |   EndStatement
''
function cCompoundStmt as integer
    '' QB mode?
    if( env.clopt.lang = FB_LANG_QB ) then
    	if( lexGetType() <> FB_DATATYPE_INVALID ) then
    		return FALSE
    	end if
    end if

	select case as const lexGetToken( )
	case FB_TK_IF
		CHECK_CODEMASK( FB_TK_IF, FB_TK_IF )
		cIfStmtBegin( )

	case FB_TK_FOR
		CHECK_CODEMASK( FB_TK_FOR, FB_TK_NEXT )
		cForStmtBegin( )

	case FB_TK_DO
		CHECK_CODEMASK( FB_TK_DO, FB_TK_LOOP )
		cDoStmtBegin( )

	case FB_TK_WHILE
		CHECK_CODEMASK( FB_TK_WHILE, FB_TK_WEND )
		cWhileStmtBegin( )

	case FB_TK_SELECT
		CHECK_CODEMASK( FB_TK_SELECT, FB_TK_SELECT )
		cSelectStmtBegin( )

	case FB_TK_WITH
		CHECK_CODEMASK( FB_TK_WITH, FB_TK_WITH )
		cWithStmtBegin()

	case FB_TK_SCOPE
		CHECK_CODEMASK( FB_TK_SCOPE, FB_TK_SCOPE )
		cScopeStmtBegin( )

	case FB_TK_NAMESPACE
		cNamespaceStmtBegin( )

	case FB_TK_EXTERN
		cExternStmtBegin( )

	case FB_TK_ELSE, FB_TK_ELSEIF
		cIfStmtNext( )

	case FB_TK_CASE
		cSelectStmtNext( )

	case FB_TK_LOOP
		cDoStmtEnd( )

	case FB_TK_NEXT
		cForStmtEnd( )

	case FB_TK_WEND
		cWhileStmtEnd( )

	case FB_TK_EXIT
		cExitStatement( )

	case FB_TK_CONTINUE
		cContinueStatement( )

	case FB_TK_END
		'' any compound END will be parsed by the compound stmt
		if( lexGetLookAheadClass( 1 ) <> FB_TKCLASS_KEYWORD ) then
			CHECK_CODEMASK( INVALID, INVALID )
			cEndStatement( )
		else
			cCompoundEnd( )
		end if

	case FB_TK_ENDIF
		cIfStmtEnd( )

	case FB_TK_USING
		cUsingStmt( )

	case else
		return FALSE
	end select

	function = TRUE
end function

'' EndStatement  =  END Expression? .
sub cEndStatement( )
	dim as ASTNODE ptr errlevel = any

	'' END
	lexSkipToken( )

  	'' Expression?
  	select case as const lexGetToken( )
  	case FB_TK_STMTSEP, FB_TK_EOL, FB_TK_EOF, FB_TK_COMMENT, FB_TK_REM, _
  		 FB_TK_ELSE, FB_TK_END, FB_TK_ENDIF
		errlevel = NULL
  	case else
  		errlevel = cExpression( )
  	end select

	rtlExitApp( errlevel )
end sub

function hCheckForCtorResult( ) as integer
	function = FB_ERRMSG_OK
	if( symbHasCtor( parser.currproc ) ) then
		if( symbGetProcStatReturnUsed( parser.currproc ) ) then
			'' EXIT FUNCTION cannot be allowed in combination
			'' with RETURN and a ctor result, because it would
			'' not call the result constructor.
			function = FB_ERRMSG_MISSINGRETURNFORCTORRESULT
		else
			'' EXIT FUNCTION used, and no RETURN yet:
			'' make it behave like FUNCTION=, to ensure the result ctor
			'' is called at the top.
			symbSetProcStatAssignUsed( parser.currproc )
		end if
	end if
end function

'':::::
#macro hExitError( errnum )
	errReport( errnum )
	'' error recovery: skip stmt
	hSkipStmt( )
	return
#endmacro

'' ExitStatement  =  EXIT (FOR | DO | WHILE | SELECT | SUB | FUNCTION)
sub cExitStatement( )
	dim as FBSYMBOL ptr label = NULL

	'' EXIT
	lexSkipToken( )

	'' (FOR | DO | WHILE | SELECT | SUB | FUNCTION) (',')*
	select case as const lexGetToken( )
	case FB_TK_FOR
		if( parser.stmt.for = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDEFORSTMT )
		end if

		lexSkipToken( )

		dim as FB_CMPSTMTSTK ptr stk = parser.stmt.for
		do while( lexGetToken( ) = CHAR_COMMA )
			lexSkipToken( )

			if( lexGetToken( ) <> FB_TK_FOR ) then
				hExitError( FB_ERRMSG_EXPECTEDFOR )
			end if

			stk = stk->for.last
			if( stk = NULL ) then
				hExitError( FB_ERRMSG_NOENCLOSEDFORSTMT )
			end if

			lexSkipToken( )
		loop

		label = stk->for.endlabel

	case FB_TK_DO
		if( parser.stmt.do = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDEDOSTMT )
		end if

		lexSkipToken( )

		dim as FB_CMPSTMTSTK ptr stk = parser.stmt.do
		do while( lexGetToken( ) = CHAR_COMMA )
			lexSkipToken( )

			if( lexGetToken( ) <> FB_TK_DO ) then
				hExitError( FB_ERRMSG_EXPECTEDDO )
			end if

			stk = stk->do.last
			if( stk = NULL ) then
				hExitError( FB_ERRMSG_NOENCLOSEDDOSTMT )
			end if

			lexSkipToken( )
		loop

		label = stk->do.endlabel

	case FB_TK_WHILE
		if( parser.stmt.while = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDEWHILESTMT )
		end if

		lexSkipToken( )

		dim as FB_CMPSTMTSTK ptr stk = parser.stmt.while
		do while( lexGetToken( ) = CHAR_COMMA )
			lexSkipToken( )

			if( lexGetToken( ) <> FB_TK_WHILE ) then
				hExitError( FB_ERRMSG_EXPECTEDWHILE )
			end if

			stk = stk->while.last
			if( stk = NULL ) then
				hExitError( FB_ERRMSG_NOENCLOSEDWHILESTMT )
			end if

			lexSkipToken( )
		loop

		label = stk->while.endlabel

	case FB_TK_SELECT
		if( parser.stmt.select = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDESELSTMT )
		end if

		lexSkipToken( )

		dim as FB_CMPSTMTSTK ptr stk = parser.stmt.select
		do while( lexGetToken( ) = CHAR_COMMA )
			lexSkipToken( )

			if( lexGetToken( ) <> FB_TK_SELECT ) then
				hExitError( FB_ERRMSG_EXPECTEDSELECT )
			end if

			stk = stk->select.last
			if( stk = NULL ) then
				hExitError( FB_ERRMSG_NOENCLOSEDSELSTMT )
			end if

			lexSkipToken( )
		loop

		label = stk->select.endlabel

	case FB_TK_SUB, FB_TK_FUNCTION, FB_TK_PROPERTY, FB_TK_OPERATOR, _
		 FB_TK_CONSTRUCTOR, FB_TK_DESTRUCTOR

		if( parser.stmt.proc <> NULL ) then
			label = parser.stmt.proc->proc.endlabel
		end if

		if( label = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDEAPROC )
		end if

		dim as FB_ERRMSG errnum = FB_ERRMSG_OK

		select case as const lexGetToken( )
		case FB_TK_SUB
			if( symbGetType( parser.currproc ) = FB_DATATYPE_VOID ) then
				if( (symbGetAttrib( parser.currproc ) and _
					 (FB_SYMBATTRIB_PROPERTY or FB_SYMBATTRIB_OPERATOR or _
					  FB_SYMBATTRIB_CONSTRUCTOR or FB_SYMBATTRIB_DESTRUCTOR)) <> 0 ) then
					errnum = FB_ERRMSG_ILLEGALOUTSIDEASUB
				end if
			else
				errnum = FB_ERRMSG_ILLEGALOUTSIDEASUB
			end if

		case FB_TK_FUNCTION
			if( symbGetType( parser.currproc ) <> FB_DATATYPE_VOID ) then
				if( (symbGetAttrib( parser.currproc ) and _
					 (FB_SYMBATTRIB_PROPERTY or FB_SYMBATTRIB_OPERATOR or _
					  FB_SYMBATTRIB_CONSTRUCTOR or FB_SYMBATTRIB_DESTRUCTOR)) <> 0 ) then
					errnum = FB_ERRMSG_ILLEGALOUTSIDEAFUNCTION
				else
					errnum = hCheckForCtorResult( )
				end if
			else
				errnum = FB_ERRMSG_ILLEGALOUTSIDEAFUNCTION
			end if

		case FB_TK_PROPERTY
			if( symbIsProperty( parser.currproc ) ) then
				errnum = hCheckForCtorResult( )
			else
				errnum = FB_ERRMSG_ILLEGALOUTSIDEANPROPERTY
			end if

		case FB_TK_OPERATOR
			if( symbIsOperator( parser.currproc ) ) then
				errnum = hCheckForCtorResult( )
			else
				errnum = FB_ERRMSG_ILLEGALOUTSIDEANOPERATOR
			end if

		case FB_TK_CONSTRUCTOR
			if( symbIsConstructor( parser.currproc ) = FALSE ) then
				errnum = FB_ERRMSG_ILLEGALOUTSIDEACTOR
			end if

		case FB_TK_DESTRUCTOR
			if( symbIsDestructor( parser.currproc ) = FALSE ) then
				errnum = FB_ERRMSG_ILLEGALOUTSIDEADTOR
			end if

		end select

		if( errnum <> FB_ERRMSG_OK ) then
			hExitError( errnum )
		end if

		lexSkipToken( )

	case else
		hExitError( FB_ERRMSG_INVALIDEXITSTMT )
	end select

	astScopeBreak( label )
end sub

'' ContinueStatement  =  CONTINUE (FOR | DO | WHILE)
sub cContinueStatement( )
	dim as FBSYMBOL ptr label = NULL

	'' CONTINUE
	lexSkipToken( )

	'' (FOR | DO | WHILE) (',')*
	select case as const lexGetToken( )
	case FB_TK_FOR
		if( parser.stmt.for = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDEFORSTMT )
		end if

		lexSkipToken( )

		dim as FB_CMPSTMTSTK ptr stk = parser.stmt.for
		do while( lexGetToken( ) = CHAR_COMMA )
			lexSkipToken( )

			if( lexGetToken( ) <> FB_TK_FOR ) then
				hExitError( FB_ERRMSG_EXPECTEDFOR )
			end if

			stk = stk->for.last
			if( stk = NULL ) then
				hExitError( FB_ERRMSG_NOENCLOSEDFORSTMT )
			end if

			lexSkipToken( )
		loop

		label = stk->for.cmplabel

	case FB_TK_DO
		if( parser.stmt.do = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDEDOSTMT )
		end if

		lexSkipToken( )

		dim as FB_CMPSTMTSTK ptr stk = parser.stmt.do
		do while( lexGetToken( ) = CHAR_COMMA )
			lexSkipToken( )

			if( lexGetToken( ) <> FB_TK_DO ) then
				hExitError( FB_ERRMSG_EXPECTEDDO )
			end if

			stk = stk->do.last
			if( stk = NULL ) then
				hExitError( FB_ERRMSG_NOENCLOSEDDOSTMT )
			end if

			lexSkipToken( )
		loop

		label = stk->do.cmplabel

	case FB_TK_WHILE
		if( parser.stmt.while = NULL ) then
			hExitError( FB_ERRMSG_ILLEGALOUTSIDEWHILESTMT )
		end if

		lexSkipToken( )

		dim as FB_CMPSTMTSTK ptr stk = parser.stmt.while
		do while( lexGetToken( ) = CHAR_COMMA )
			lexSkipToken( )

			if( lexGetToken( ) <> FB_TK_WHILE ) then
				hExitError( FB_ERRMSG_EXPECTEDWHILE )
			end if

			stk = stk->while.last
			if( stk = NULL ) then
				hExitError( FB_ERRMSG_NOENCLOSEDWHILESTMT )
			end if

			lexSkipToken( )
		loop

		label = stk->while.cmplabel

	case else
		hExitError( FB_ERRMSG_INVALIDCONTINUESTMT )
	end select

	astScopeBreak( label )
end sub

'' CompoundEnd  =  END (IF | SELECT | SUB | FUNCTION | SCOPE | WITH | NAMESPACE | EXTERN)
sub cCompoundEnd( )
	select case as const lexGetLookAhead( 1 )
	case FB_TK_IF
		cIfStmtEnd( )

	case FB_TK_SELECT
		cSelectStmtEnd( )

	case FB_TK_SUB, FB_TK_FUNCTION, FB_TK_CONSTRUCTOR, FB_TK_DESTRUCTOR, _
		 FB_TK_OPERATOR, FB_TK_PROPERTY
		cProcStmtEnd( )

	case FB_TK_SCOPE
		cScopeStmtEnd( )

	case FB_TK_WITH
		cWithStmtEnd( )

	case FB_TK_NAMESPACE
		cNamespaceStmtEnd( )

	case FB_TK_EXTERN
		cExternStmtEnd( )

	'' QB quirk: IF expr THEN END ELSE ...|ENDIF|END IF
	case FB_TK_ELSE, FB_TK_END, FB_TK_ENDIF
		cEndStatement( )

	case else
		errReport( FB_ERRMSG_ILLEGALEND )
		'' error recovery: skip stmt
		hSkipStmt( )
	end select
end sub

'':::::
function cCompStmtCheck( ) as integer
    dim as integer errmsg
    dim as FB_CMPSTMTSTK ptr stk

    stk = stackGetTOS( @parser.stmt.stk )
    if( stk = NULL ) then
    	return TRUE
    end if

    select case as const stk->id
    case FB_TK_IF
    	errmsg = FB_ERRMSG_EXPECTEDENDIF

    case FB_TK_SELECT
    	errmsg = FB_ERRMSG_EXPECTEDENDSELECT

    case FB_TK_SCOPE
    	errmsg = FB_ERRMSG_EXPECTEDENDSCOPE

    case FB_TK_WITH
    	errmsg = FB_ERRMSG_EXPECTEDENDWITH

    case FB_TK_NAMESPACE
    	errmsg = FB_ERRMSG_EXPECTEDENDNAMESPACE

    case FB_TK_EXTERN
    	errmsg = FB_ERRMSG_EXPECTEDENDEXTERN

    case FB_TK_FUNCTION
		select case as const stk->proc.tkn
		case FB_TK_SUB
			errmsg = FB_ERRMSG_EXPECTEDENDSUB
		case FB_TK_FUNCTION
			errmsg = FB_ERRMSG_EXPECTEDENDFUNCTION
		case FB_TK_CONSTRUCTOR
			errmsg = FB_ERRMSG_EXPECTEDENDCTOR
		case FB_TK_DESTRUCTOR
			errmsg = FB_ERRMSG_EXPECTEDENDDTOR
		case FB_TK_OPERATOR
			errmsg = FB_ERRMSG_EXPECTEDENDOPERATOR
		case FB_TK_PROPERTY
			errmsg = FB_ERRMSG_EXPECTEDENDPROPERTY
		end select

    case FB_TK_DO
    	errmsg = FB_ERRMSG_EXPECTEDLOOP

    case FB_TK_WHILE
    	errmsg = FB_ERRMSG_EXPECTEDWEND

    case FB_TK_FOR
    	errmsg = FB_ERRMSG_EXPECTEDNEXT

    end select

    errReport( errmsg )

    function = FALSE

end function

'':::::
function cCompStmtPush _
	( _
		byval id as FB_TOKEN, _
		byval allowmask as FB_CMPSTMT_MASK _
	) as FB_CMPSTMTSTK ptr static

	dim as FB_CMPSTMTSTK ptr stk

	stk = stackPush( @parser.stmt.stk )
	stk->id = id
	stk->allowmask = allowmask
	stk->scopenode = NULL

	'' same current values, if any
	select case as const id
	case FB_TK_DO
		stk->do.last = parser.stmt.do
		parser.stmt.do = stk

	case FB_TK_FOR
		stk->for.last = parser.stmt.for
		parser.stmt.for = stk

	case FB_TK_SELECT
		stk->select.last = parser.stmt.select
		parser.stmt.select = stk

	case FB_TK_WHILE
		stk->while.last = parser.stmt.while
		parser.stmt.while = stk

	case FB_TK_FUNCTION
		stk->proc.last = parser.stmt.proc
		parser.stmt.proc = stk
	end select

	parser.stmt.id = id

	function = stk

end function

'':::::
function cCompStmtGetTOS _
	( _
		byval forid as FB_TOKEN, _
		byval showerror as integer _
	) as FB_CMPSTMTSTK ptr static

	dim as FB_CMPSTMTSTK ptr stk
	dim as integer iserror

	stk = stackGetTOS( @parser.stmt.stk )
	iserror = (stk = NULL)

	if( iserror = FALSE ) then
		'' not the expected id?
		iserror = (stk->id <> forid)
	end if

	if( iserror ) then
		if( showerror ) then
			if( stk <> NULL ) then
				cCompStmtCheck( )

			else
				dim as integer errmsg
				select case as const forid
				case FB_TK_DO
					errmsg = FB_ERRMSG_LOOPWITHOUTDO

        		case FB_TK_EXTERN
        			errmsg = FB_ERRMSG_ENDEXTERNWITHOUTEXTERN

				case FB_TK_FOR
					errmsg = FB_ERRMSG_NEXTWITHOUTFOR

				case FB_TK_IF
					errmsg = FB_ERRMSG_ENDIFWITHOUTIF

				case FB_TK_SCOPE
					errmsg = FB_ERRMSG_ENDSCOPEWITHOUTSCOPE

				case FB_TK_SELECT
					errmsg = FB_ERRMSG_ENDSELECTWITHOUTSELECT

				case FB_TK_WHILE
					errmsg = FB_ERRMSG_WENDWITHOUTWHILE

				case FB_TK_WITH
					errmsg = FB_ERRMSG_ENDWITHWITHOUTWITH

            	case FB_TK_FUNCTION
            		errmsg = FB_ERRMSG_ENDSUBWITHOUTSUB

				case FB_TK_NAMESPACE
            		errmsg = FB_ERRMSG_ENDNAMESPACEWITHOUTNAMESPACE
				end select

				errReport( errmsg )
			end if
		end if

		function = NULL

	else
		function = stk
	end if

end function

sub cCompStmtPop( byval stk as FB_CMPSTMTSTK ptr )
	'' restore old values if any
	select case as const stk->id
	case FB_TK_DO
		parser.stmt.do = stk->do.last

	case FB_TK_FOR
		parser.stmt.for = stk->for.last

	case FB_TK_SELECT
		parser.stmt.select = stk->select.last

	case FB_TK_WHILE
		parser.stmt.while = stk->while.last

	case FB_TK_FUNCTION
		parser.stmt.proc = stk->proc.last
	end select

	stackPop( @parser.stmt.stk )

	stk = stackGetTOS( @parser.stmt.stk )
	if( stk ) then
		parser.stmt.id = stk->id
	else
		parser.stmt.id = 0
	end if
end sub

function cCompStmtIsAllowed( byval allowmask as FB_CMPSTMT_MASK ) as integer
	dim as FB_CMPSTMTSTK ptr stk = any
	dim as integer errmsg = any

	stk = stackGetTOS( @parser.stmt.stk )

	'' module-level? anything allowed..
	if( stk = NULL ) then
		return TRUE
	end if

	'' allowed?
	if( stk->allowmask and allowmask ) then
		return TRUE
	end if

	'' error..
	if( fbIsModLevel( ) = FALSE ) then
		errmsg = FB_ERRMSG_ILLEGALINSIDEASUB
	else
		if( symbIsGlobalNamespc( ) ) then
			if( stk->id = FB_TK_SELECT ) then
				errmsg = FB_ERRMSG_ILLEGALINSIDESELECT
			else
				errmsg = FB_ERRMSG_ILLEGALINSIDEASCOPE
			end if
		else
			errmsg = FB_ERRMSG_ILLEGALINSIDEANAMESPC
		end if
	end if

    errReport( errmsg )

	function = FALSE
end function