/// ParseEQUIVALENCEStmt - Parse the EQUIVALENCE statement.
///
/// [R554]:
/// equivalence-stmt :=
/// EQUIVALENCE equivalence-set-list
Parser::StmtResult Parser::ParseEQUIVALENCEStmt() {
// Check if this is an assignment.
if (IsNextToken(tok::equal))
return StmtResult();
auto Loc = ConsumeToken();
SmallVector<Stmt*, 8> StmtList;
SmallVector<Expr*, 8> ObjectList;
bool OuterError = false;
while(true) {
auto PartLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::l_paren)) {
if(!SkipUntil(tok::l_paren)) {
OuterError = true;
break;
}
}
ObjectList.clear();
bool InnerError = false;
do {
auto E = ParseExpectedExpression();
if(E.isInvalid()) {
InnerError = true;
break;
} else if(E.isUsable())
ObjectList.push_back(E.get());
} while(ConsumeIfPresent(tok::comma));
auto S = Actions.ActOnEQUIVALENCE(Context, Loc, PartLoc, ObjectList, nullptr);
if(S.isUsable())
StmtList.push_back(S.get());
if(InnerError) {
if(!SkipUntil(tok::r_paren, true, true)) {
OuterError = true;
break;
}
}
if(!ExpectAndConsume(tok::r_paren)) {
if(!SkipUntil(tok::r_paren)) {
OuterError = true;
break;
}
}
if(ConsumeIfPresent(tok::comma)) continue;
if(IsPresent(tok::l_paren)) {
ExpectAndConsume(tok::comma);
continue;
}
break;
}
if(OuterError) SkipUntilNextStatement();
else ExpectStatementEnd();
return Actions.ActOnCompoundStmt(Context, Loc, StmtList, StmtLabel);
}
/// ParseCOMMONStmt - Parse the COMMON statement.
///
/// [5.5.2] R557:
/// common-stmt :=
/// COMMON #
/// # [ / [common-block-name] / ] common-block-object-list #
/// # [ [,] / [common-block-name / #
/// # common-block-object-list ] ...
Parser::StmtResult Parser::ParseCOMMONStmt() {
// Check if this is an assignment.
if (IsNextToken(tok::equal))
return StmtResult();
auto Loc = ConsumeToken();
SmallVector<Stmt*, 8> StmtList;
SmallVector<Expr*, 8> ObjectList;
SourceLocation BlockIDLoc;
const IdentifierInfo *BlockID = nullptr;
bool Error = false;
do {
if(ConsumeIfPresent(tok::slash)) {
if(ConsumeIfPresent(tok::slash))
BlockID = nullptr;
else {
BlockIDLoc = Tok.getLocation();
BlockID = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier)) {
Error = true;
break;
}
if(!ExpectAndConsume(tok::slash)) {
Error = true;
break;
}
}
} else if(ConsumeIfPresent(tok::slashslash))
BlockID = nullptr;
auto IDLoc = Tok.getLocation();
auto IDInfo = Tok.getIdentifierInfo();
SmallVector<ArraySpec*, 8> Dimensions;
if(!ExpectAndConsume(tok::identifier)) {
Error = true;
break;
}
if(IsPresent(tok::l_paren)) {
if(ParseArraySpec(Dimensions)) {
Error = true;
break;
}
}
Actions.ActOnCOMMON(Context, Loc, BlockIDLoc,
IDLoc, BlockID, IDInfo,
Dimensions);
} while(ConsumeIfPresent(tok::comma));
if(Error) SkipUntilNextStatement();
else ExpectStatementEnd();
return Actions.ActOnCompoundStmt(Context, Loc, StmtList, StmtLabel);
}
/// ParsePARAMETERStmt - Parse the PARAMETER statement.
///
/// [R548]:
/// parameter-stmt :=
/// PARAMETER ( named-constant-def-list )
Parser::StmtResult Parser::ParsePARAMETERStmt() {
// Check if this is an assignment.
if (IsNextToken(tok::equal))
return StmtResult();
auto Loc = ConsumeToken();
SmallVector<Stmt*, 8> StmtList;
if(!ExpectAndConsume(tok::l_paren)) {
if(!SkipUntil(tok::l_paren))
return StmtError();
}
while(true) {
auto IDLoc = Tok.getLocation();
auto II = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier)) {
if(!SkipUntil(tok::comma)) break;
else continue;
}
auto EqualLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::equal)) {
if(!SkipUntil(tok::comma)) break;
else continue;
}
ExprResult ConstExpr = ParseExpression();
if(ConstExpr.isUsable()) {
auto Stmt = Actions.ActOnPARAMETER(Context, Loc, EqualLoc,
IDLoc, II,
ConstExpr, nullptr);
if(Stmt.isUsable())
StmtList.push_back(Stmt.take());
}
if(ConsumeIfPresent(tok::comma))
continue;
if(isTokenIdentifier() && !Tok.isAtStartOfStatement()) {
ExpectAndConsume(tok::comma);
continue;
}
break;
}
if(!ExpectAndConsume(tok::r_paren))
SkipUntilNextStatement();
return Actions.ActOnCompoundStmt(Context, Loc, StmtList, StmtLabel);
}
// ParseLevel1Expr - Level-1 expressions are primaries optionally operated on by
// defined unary operators.
//
// R702:
// level-1-expr :=
// [ defined-unary-op ] primary
// R703:
// defined-unary-op :=
// . letter [ letter ] ... .
Parser::ExprResult Parser::ParseLevel1Expr() {
SourceLocation OpLoc = Tok.getLocation();
IdentifierInfo *II = 0;
if (IsPresent(tok::defined_operator) && !IsNextToken(tok::l_paren)) {
II = Tok.getIdentifierInfo();
Lex();
}
ExprResult E = ParsePrimaryExpr();
if (E.isInvalid()) return E;
if (II)
E = DefinedUnaryOperatorExpr::Create(Context, OpLoc, E.take(), II);
return E;
}
/// ParseINTRINSICStmt - Parse the INTRINSIC statement.
///
/// [R1216]:
/// intrinsic-stmt :=
/// INTRINSIC [::] intrinsic-procedure-name-list
Parser::StmtResult Parser::ParseINTRINSICStmt(bool IsActuallyExternal) {
// Check if this is an assignment.
if (IsNextToken(tok::equal))
return StmtResult();
auto Loc = ConsumeToken();
ConsumeIfPresent(tok::coloncolon);
SmallVector<Stmt *,8> StmtList;
while(true) {
auto IDLoc = Tok.getLocation();
auto II = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier)) {
if(!SkipUntil(tok::comma, tok::identifier, true, true)) break;
if(ConsumeIfPresent(tok::comma)) continue;
else {
IDLoc = Tok.getLocation();
II = Tok.getIdentifierInfo();
ConsumeToken();
}
}
auto Stmt = IsActuallyExternal?
Actions.ActOnEXTERNAL(Context, Loc, IDLoc,
II, nullptr):
Actions.ActOnINTRINSIC(Context, Loc, IDLoc,
II, nullptr);
if(Stmt.isUsable())
StmtList.push_back(Stmt.take());
if(Tok.isAtStartOfStatement()) break;
if(!ExpectAndConsume(tok::comma)) {
if(!SkipUntil(tok::comma)) break;
}
}
return Actions.ActOnCompoundStmt(Context, Loc, StmtList, StmtLabel);
}
/// ParseDIMENSIONStmt - Parse the DIMENSION statement.
///
/// [R535]:
/// dimension-stmt :=
/// DIMENSION [::] array-name ( array-spec ) #
/// # [ , array-name ( array-spec ) ] ...
Parser::StmtResult Parser::ParseDIMENSIONStmt() {
// Check if this is an assignment.
if (IsNextToken(tok::equal))
return StmtResult();
auto Loc = ConsumeToken();
ConsumeIfPresent(tok::coloncolon);
SmallVector<Stmt*, 8> StmtList;
SmallVector<ArraySpec*, 4> Dimensions;
while (true) {
auto IDLoc = Tok.getLocation();
auto II = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier)) {
if(!SkipUntil(tok::comma, tok::identifier, true, true)) break;
if(ConsumeIfPresent(tok::comma)) continue;
else {
IDLoc = Tok.getLocation();
II = Tok.getIdentifierInfo();
ConsumeToken();
}
}
// FIXME: improve error recovery
Dimensions.clear();
if(ParseArraySpec(Dimensions)) return StmtError();
auto Stmt = Actions.ActOnDIMENSION(Context, Loc, IDLoc, II,
Dimensions, nullptr);
if(Stmt.isUsable()) StmtList.push_back(Stmt.take());
if(Tok.isAtStartOfStatement()) break;
if(!ExpectAndConsume(tok::comma)) {
if(!SkipUntil(tok::comma)) break;
}
}
return Actions.ActOnCompoundStmt(Context, Loc, StmtList, StmtLabel);
}
/// ParseSAVEStmt - Parse the SAVE statement.
///
/// [R543]:
/// save-stmt :=
/// SAVE [ [::] saved-entity-list ]
Parser::StmtResult Parser::ParseSAVEStmt() {
// Check if this is an assignment.
if (IsNextToken(tok::equal))
return StmtResult();
auto Loc = ConsumeToken();
if(Tok.isAtStartOfStatement())
return Actions.ActOnSAVE(Context, Loc, StmtLabel);
bool IsSaveStmt = ConsumeIfPresent(tok::coloncolon);
SmallVector<Stmt *,8> StmtList;
bool ListParsedOk = true;
auto IDLoc = Tok.getLocation();
auto II = Tok.getIdentifierInfo();
StmtResult Stmt;
if(ConsumeIfPresent(tok::slash)) {
IDLoc = Tok.getLocation();
II = Tok.getIdentifierInfo();
if(ExpectAndConsume(tok::identifier)) {
if(!ExpectAndConsume(tok::slash))
ListParsedOk = false;
Stmt = Actions.ActOnSAVECommonBlock(Context, Loc, IDLoc, II);
}
else ListParsedOk = false;
}
else if(ExpectAndConsume(tok::identifier)) {
if(!IsSaveStmt && Features.FixedForm && (IsPresent(tok::equal) || IsPresent(tok::l_paren)))
return ReparseAmbiguousAssignmentStatement();
Stmt = Actions.ActOnSAVE(Context, Loc, IDLoc, II, nullptr);
} else ListParsedOk = false;
if(Stmt.isUsable())
StmtList.push_back(Stmt.get());
if(ListParsedOk) {
while(ConsumeIfPresent(tok::comma)) {
IDLoc = Tok.getLocation();
II = Tok.getIdentifierInfo();
if(ConsumeIfPresent(tok::slash)) {
IDLoc = Tok.getLocation();
II = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier)) {
ListParsedOk = false;
break;
}
if(!ExpectAndConsume(tok::slash)) {
ListParsedOk = false;
break;
}
Stmt = Actions.ActOnSAVECommonBlock(Context, Loc, IDLoc, II);
}
else if(ExpectAndConsume(tok::identifier))
Stmt = Actions.ActOnSAVE(Context, Loc, IDLoc, II, nullptr);
else {
ListParsedOk = false;
break;
}
if(Stmt.isUsable())
StmtList.push_back(Stmt.get());
}
}
if(ListParsedOk) ExpectStatementEnd();
else SkipUntilNextStatement();
return Actions.ActOnCompoundStmt(Context, Loc, StmtList, StmtLabel);
}
/// ParseIMPLICITStmt - Parse the IMPLICIT statement.
///
/// [R560]:
/// implicit-stmt :=
/// IMPLICIT implicit-spec-list
/// or IMPLICIT NONE
Parser::StmtResult Parser::ParseIMPLICITStmt() {
// Check if this is an assignment.
if (IsNextToken(tok::equal))
return StmtResult();
auto Loc = ConsumeToken();
if (ConsumeIfPresent(tok::kw_NONE)) {
auto Result = Actions.ActOnIMPLICIT(Context, Loc, StmtLabel);
ExpectStatementEnd();
return Result;
}
SmallVector<Stmt*, 8> StmtList;
while(true) {
// FIXME: improved error recovery
DeclSpec DS;
if (ParseDeclarationTypeSpec(DS, false))
return StmtError();
if(!ExpectAndConsume(tok::l_paren)) {
if(!SkipUntil(tok::l_paren))
break;
}
bool InnerError = false;
while(true) {
auto FirstLoc = Tok.getLocation();
auto First = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier, diag::err_expected_letter)) {
if(!SkipUntil(tok::comma)) {
InnerError = true;
break;
}
continue;
}
if(First->getName().size() > 1) {
Diag.Report(FirstLoc, diag::err_expected_letter);
}
const IdentifierInfo *Second = nullptr;
if (ConsumeIfPresent(tok::minus)) {
auto SecondLoc = Tok.getLocation();
Second = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier, diag::err_expected_letter)) {
if(!SkipUntil(tok::comma)) {
InnerError = true;
break;
}
continue;
}
if(Second->getName().size() > 1) {
Diag.Report(SecondLoc, diag::err_expected_letter);
}
}
auto Stmt = Actions.ActOnIMPLICIT(Context, Loc, DS,
std::make_pair(First, Second), nullptr);
if(Stmt.isUsable())
StmtList.push_back(Stmt.take());
if(ConsumeIfPresent(tok::comma))
continue;
break;
}
if(InnerError && Tok.isAtStartOfStatement())
break;
if(!ExpectAndConsume(tok::r_paren)) {
if(!SkipUntil(tok::r_paren))
break;
}
if(Tok.isAtStartOfStatement()) break;
if(!ExpectAndConsume(tok::comma)) {
if(!SkipUntil(tok::comma))
break;
}
}
ExpectStatementEnd();
return Actions.ActOnCompoundStmt(Context, Loc, StmtList, StmtLabel);
}
/// ParseActionStmt - Parse an action statement.
///
/// [R214]:
/// action-stmt :=
/// allocate-stmt
/// or assignment-stmt
/// or backspace-stmt
/// or call-stmt
/// or close-stmt
/// or continue-stmt
/// or cycle-stmt
/// or deallocate-stmt
/// or end-function-stmt
/// or end-mp-subprogram-stmt
/// or end-program-stmt
/// or end-subroutine-stmt
/// or endfile-stmt
/// or error-stop-stmt
/// or exit-stmt
/// or flush-stmt
/// or forall-stmt
/// or goto-stmt
/// or if-stmt
/// or inquire-stmt
/// or lock-stmt
/// or nullify-stmt
/// or open-stmt
/// or pointer-assignment-stmt
/// or print-stmt
/// or read-stmt
/// or return-stmt
/// or rewind-stmt
/// or stop-stmt
/// or sync-all-stmt
/// or sync-images-stmt
/// or sync-memory-stmt
/// or unlock-stmt
/// or wait-stmt
/// or where-stmt
/// or write-stmt
///[obs] or arithmetic-if-stmt
///[obs] or computed-goto-stmt
Parser::StmtResult Parser::ParseActionStmt() {
StmtResult SR;
switch (Tok.getKind()) {
default:
return ParseAssignmentStmt();
case tok::kw_ASSIGN:
return ParseAssignStmt();
case tok::kw_GOTO:
return ParseGotoStmt();
case tok::kw_IF:
return ParseIfStmt();
case tok::kw_ELSEIF:
return ParseElseIfStmt();
case tok::kw_ELSE:
return ParseElseStmt();
case tok::kw_ENDIF:
return ParseEndIfStmt();
case tok::kw_DO:
return ParseDoStmt();
case tok::kw_DOWHILE:
if(Features.FixedForm) {
if(!IsNextToken(tok::l_paren))
return ReparseAmbiguousDoWhileStatement();
}
return ParseDoWhileStmt(false);
case tok::kw_ENDDO:
return ParseEndDoStmt();
case tok::kw_CYCLE:
return ParseCycleStmt();
case tok::kw_SELECTCASE:
return ParseSelectCaseStmt();
case tok::kw_CASE:
return ParseCaseStmt();
case tok::kw_ENDSELECT:
return ParseEndSelectStmt();
case tok::kw_EXIT:
return ParseExitStmt();
case tok::kw_CONTINUE:
return ParseContinueStmt();
case tok::kw_STOP:
return ParseStopStmt();
case tok::kw_PRINT:
return ParsePrintStmt();
case tok::kw_WRITE:
return ParseWriteStmt();
case tok::kw_FORMAT:
return ParseFORMATStmt();
case tok::kw_RETURN:
return ParseReturnStmt();
case tok::kw_CALL:
return ParseCallStmt();
case tok::kw_WHERE:
return ParseWhereStmt();
case tok::kw_ELSEWHERE:
return ParseElseWhereStmt();
case tok::kw_ENDWHERE:
return ParseEndWhereStmt();
case tok::kw_READ:
case tok::kw_OPEN:
case tok::kw_CLOSE:
case tok::kw_INQUIRE:
case tok::kw_BACKSPACE:
case tok::kw_ENDFILE:
case tok::kw_REWIND:
Diag.Report(ConsumeToken(), diag::err_unsupported_stmt);
return StmtError();
case tok::kw_END:
// TODO: All of the end-* stmts.
case tok::kw_ENDFUNCTION:
case tok::kw_ENDPROGRAM:
case tok::kw_ENDSUBPROGRAM:
case tok::kw_ENDSUBROUTINE:
if(Features.FixedForm) {
auto StmtPoint = LocFirstStmtToken;
auto RetPoint = ConsumeToken();
ConsumeIfPresent(tok::identifier);
if(IsPresent(tok::l_paren) || IsPresent(tok::equal))
return ReparseAmbiguousAssignmentStatement(StmtPoint);
StartStatementReparse(RetPoint);
LookForExecutableStmtKeyword(StmtLabel? false : true);
}
// Handle in parent.
return StmtResult();
case tok::eof:
return StmtResult();
}
return SR;
}
