/// 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; }