//========================================================================================
// R1234 subroutine-stmt
//----------------------------------------------------------------------------------------
void UntypedASTBuilder::build_SubroutineStmt(SubroutineStmt * subroutineStmt)
{
Sg_File_Info * start = NULL;
SgUntypedSubroutineDeclaration * subroutine = NULL;
// set up the function scope
//
SgUntypedFunctionScope * scope = new SgUntypedFunctionScope(start);
scope->set_declaration_list(new SgUntypedDeclarationList(start));
scope->set_statement_list(new SgUntypedStatementList(start));
scope->set_function_list(new SgUntypedFunctionDeclarationList(start));
subroutine = new SgUntypedSubroutineDeclaration(start, subroutineStmt->getSubroutineName()->getIdent()->getName());
subroutine->set_statement_enum(SgToken::FORTRAN_SUBROUTINE);
subroutine->set_scope(scope);
if (subroutineStmt->getLabel()) subroutine->set_label_string(subroutineStmt->getLabel()->getValue());
//TODO-CER-2014.3.24 - handle prefix, arguments, language-binding
subroutineStmt->setPayload(subroutine);
}
//========================================================================================
// R1233 subroutine-subprogram
//----------------------------------------------------------------------------------------
void UntypedASTBuilder::build_SubroutineSubprogram(SubroutineSubprogram * subroutineSubprogram)
{
#if 0
Sg_File_Info * start = NULL;
SgUntypedNamedStatement * stmt = NULL;
SgUntypedDeclarationList* sgDeclList = NULL;
SgUntypedStatementList* sgStmtList = NULL;
SgUntypedSubroutineDeclaration * subroutine = NULL;
// SubroutineStmt
//
subroutine = dynamic_cast<SgUntypedSubroutineDeclaration*>(subroutineSubprogram->getSubroutineStmt()->getPayload());
assert(subroutine);
start = subroutine->get_startOfConstruct();
subroutine->set_scope(new SgUntypedFunctionScope(start));
#ifdef OFP_BUILD_DEBUG
printf("build_Subroutine label: ........... %s\n", subroutine->get_label_string().c_str());
printf(" begin name: ........... %s\n", subroutine->get_name().c_str());
#endif
// InitialSpecPart
//
InitialSpecPart * specPart = subroutineSubprogram->getInitialSpecPart();
sgDeclList = dynamic_cast<SgUntypedDeclarationList*>(specPart->givePayload()); assert(sgDeclList);
subroutine->get_scope()->set_declaration_list(sgDeclList);
#ifdef OFP_BUILD_DEBUG
printf(" spec_list_size: ........... %lu\n", sgDeclList->get_decl_list().size());
#endif
// SpecAndExecPart
//
SpecAndExecPart * execPart = subroutineSubprogram->getSpecAndExecPart();
sgStmtList = dynamic_cast<SgUntypedStatementList*>(execPart->givePayload()); assert(sgStmtList);
subroutine->get_scope()->set_statement_list(sgStmtList);
#ifdef OFP_BUILD_DEBUG
printf(" exec_list_size: ........... %lu\n", sgStmtList->get_stmt_list().size());
#endif
// InternalSubprogramPart
//
InternalSubprogramPart * isubPart = subroutineSubprogram->getInternalSubprogramPart();
if (isubPart) {
SgUntypedFunctionDeclarationList* sgFuncList;
sgFuncList = dynamic_cast<SgUntypedFunctionDeclarationList*>(isubPart->givePayload()); assert(sgFuncList);
subroutine->get_scope()->set_function_list(sgFuncList);
}
else {
subroutine->get_scope()->set_function_list(new SgUntypedFunctionDeclarationList(NULL));
}
// EndSubroutineStmt
//
stmt = dynamic_cast<SgUntypedNamedStatement*>(subroutineSubprogram->getEndSubroutineStmt()->getPayload()); assert(stmt);
subroutine->set_end_statement(stmt);
#ifdef OFP_BUILD_DEBUG
printf(" end label: ........... %s\n", stmt->get_label_string().c_str());
printf(" end name: ........... %s\n", stmt->get_statement_name().c_str());
#endif
subroutineSubprogram->setPayload(subroutine);
#endif
}