Parser::StmtResult Parser::ParseDoStmt() {
auto Loc = ConsumeToken();
auto CurStmtLoc = LocFirstStmtToken;
ExprResult TerminalStmt;
VarExpr *DoVar = nullptr;
ExprResult E1, E2, E3;
auto EqLoc = Loc;
if(IsPresent(tok::int_literal_constant)) {
TerminalStmt = ParseStatementLabelReference();
if(TerminalStmt.isInvalid()) return StmtError();
}
bool isDo = ConsumeIfPresent(tok::comma);
if(isDo && IsPresent(tok::kw_WHILE))
return ParseDoWhileStmt(isDo);
// the do var
auto IDInfo = Tok.getIdentifierInfo();
auto IDRange = getTokenRange();
auto IDLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::identifier))
goto error;
EqLoc = getMaxLocationOfCurrentToken();
if(Features.FixedForm && !isDo && IsPresent(tok::l_paren))
return ReparseAmbiguousAssignmentStatement();
if(!ExpectAndConsume(tok::equal))
goto error;
E1 = ParseExpectedFollowupExpression("=");
if(E1.isInvalid()) goto error;
if(Features.FixedForm && !isDo && Tok.isAtStartOfStatement())
return ReparseAmbiguousAssignmentStatement(CurStmtLoc);
if(!ExpectAndConsume(tok::comma)) goto error;
E2 = ParseExpectedFollowupExpression(",");
if(E2.isInvalid()) goto error;
if(ConsumeIfPresent(tok::comma)) {
E3 = ParseExpectedFollowupExpression(",");
if(E3.isInvalid()) goto error;
}
if(auto VD = Actions.ExpectVarRefOrDeclImplicitVar(IDLoc, IDInfo))
DoVar = VarExpr::Create(Context, IDRange, VD);
return Actions.ActOnDoStmt(Context, Loc, EqLoc, TerminalStmt,
DoVar, E1, E2, E3, StmtConstructName, StmtLabel);
error:
if(IDInfo) {
if(auto VD = Actions.ExpectVarRefOrDeclImplicitVar(IDLoc, IDInfo))
DoVar = VarExpr::Create(Context, IDRange, VD);
}
SkipUntilNextStatement();
return Actions.ActOnDoStmt(Context, Loc, EqLoc, TerminalStmt,
DoVar, E1, E2, E3, StmtConstructName, StmtLabel);
}
Parser::StmtResult Parser::ParseCaseStmt() {
auto Loc = ConsumeToken();
if(ConsumeIfPresent(tok::kw_DEFAULT)) {
ParseTrailingConstructName();
return Actions.ActOnCaseDefaultStmt(Context, Loc, StmtConstructName, StmtLabel);
}
SmallVector<Expr*, 8> Values;
ExpectAndConsume(tok::l_paren);
do {
auto ColonLoc = Tok.getLocation();
if(ConsumeIfPresent(tok::colon)) {
auto E = ParseExpectedFollowupExpression(":");
if(E.isInvalid()) goto error;
if(E.isUsable())
Values.push_back(RangeExpr::Create(Context, ColonLoc, nullptr, E.get()));
} else {
auto E = ParseExpectedExpression();
if(E.isInvalid()) goto error;
ColonLoc = Tok.getLocation();
if(ConsumeIfPresent(tok::colon)) {
if(!(IsPresent(tok::comma) || IsPresent(tok::r_paren))) {
auto E2 = ParseExpectedFollowupExpression(":");
if(E2.isInvalid()) goto error;
if(E.isUsable() || E2.isUsable())
Values.push_back(RangeExpr::Create(Context, ColonLoc, E.get(), E2.get()));
} else {
if(E.isUsable())
Values.push_back(RangeExpr::Create(Context, ColonLoc, E.get(), nullptr));
}
} else {
if(E.isUsable())
Values.push_back(E.get());
}
}
} while(ConsumeIfPresent(tok::comma));
if(ExpectAndConsume(tok::r_paren)) {
ParseTrailingConstructName();
} else SkipUntilNextStatement();
return Actions.ActOnCaseStmt(Context, Loc, Values, StmtConstructName, StmtLabel);
error:
if(SkipUntil(tok::r_paren)) {
ParseTrailingConstructName();
} else SkipUntilNextStatement();
return Actions.ActOnCaseStmt(Context, Loc, Values, StmtConstructName, StmtLabel);
}
bool Parser::ParseCharacterStarLengthSpec(DeclSpec &DS) {
ExprResult Len;
if(ConsumeIfPresent(tok::l_paren)) {
if(ConsumeIfPresent(tok::star)) {
DS.setStartLengthSelector();
} else Len = ParseExpectedFollowupExpression("(");
if(!ExpectAndConsume(tok::r_paren))
return true;
}
else Len = ParseExpectedFollowupExpression("*");
if(Len.isInvalid()) return true;
if(Len.isUsable()) DS.setLengthSelector(Len.take());
return false;
}
ExprResult Parser::ParseExpectedConditionExpression(const char *DiagAfter) {
if (!ExpectAndConsume(tok::l_paren, diag::err_expected_lparen_after,
DiagAfter))
return ExprError();
ExprResult Condition = ParseExpectedFollowupExpression("(");
if(Condition.isInvalid()) return Condition;
if (!ExpectAndConsume(tok::r_paren))
return ExprError();
return Condition;
}
ExprResult Parser::ParseArraySection(const char *PunctuationTok) {
ExprResult LB, UB, Stride;
bool Range = false;
auto ColonLoc = Tok.getLocation();
if(ConsumeIfPresent(tok::colon)) {
Range = true;
if(!IsPresent(tok::colon) && !IsPresent(tok::comma) && !IsPresent(tok::r_paren)) {
UB = ParseExpectedFollowupExpression(":");
if(UB.isInvalid())
return UB;
}
} else {
LB = ParseExpectedFollowupExpression(PunctuationTok);
if(LB.isInvalid())
return LB;
ColonLoc = Tok.getLocation();
if(ConsumeIfPresent(tok::colon)) {
Range = true;
if(!IsPresent(tok::colon) && !IsPresent(tok::comma) && !IsPresent(tok::r_paren)) {
UB = ParseExpectedFollowupExpression(":");
if(UB.isInvalid())
return UB;
}
}
}
if(ConsumeIfPresent(tok::colon)) {
Stride = ParseExpectedFollowupExpression(":");
if(Stride.isInvalid())
return Stride;
}
if(Stride.isUsable())
return StridedRangeExpr::Create(Context, ColonLoc, LB.get(),
UB.get(), Stride.get());
if(Range)
return RangeExpr::Create(Context, ColonLoc, LB.get(), UB.get());
return LB;
}
/// ParseAssignmentStmt
/// [R732]:
/// assignment-stmt :=
/// variable = expr
Parser::StmtResult Parser::ParseAssignmentStmt() {
ExprResult LHS = ParsePrimaryExpr(true);
if(LHS.isInvalid()) return StmtError();
SourceLocation Loc = Tok.getLocation();
if(!ConsumeIfPresent(tok::equal)) {
Diag.Report(getExpectedLoc(),diag::err_expected_equal);
return StmtError();
}
ExprResult RHS = ParseExpectedFollowupExpression("=");
if(RHS.isInvalid()) return StmtError();
return Actions.ActOnAssignmentStmt(Context, Loc, LHS, RHS, StmtLabel);
}
Parser::StmtResult Parser::ParseSelectCaseStmt() {
auto Loc = ConsumeToken();
ExprResult Operand;
if(ExpectAndConsume(tok::l_paren)) {
Operand = ParseExpectedFollowupExpression("(");
if(Operand.isUsable()) {
if(!ExpectAndConsume(tok::r_paren))
SkipUntilNextStatement();
} else SkipUntilNextStatement();
} else SkipUntilNextStatement();
return Actions.ActOnSelectCaseStmt(Context, Loc, Operand, StmtConstructName, StmtLabel);
}
/// ParseSubstring - Parse a substring.
///
/// R608:
/// substring :=
/// parent-string ( substring-range )
/// R609:
/// parent-string :=
/// scalar-variable-name
/// or array-element
/// or coindexed-named-object
/// or scalar-structure-component
/// or scalar-constant
/// R610:
/// substring-range :=
/// [ scalar-int-expr ] : [ scalar-int-expr ]
ExprResult Parser::ParseSubstring(ExprResult Target) {
ExprResult StartingPoint, EndPoint;
auto Loc = ConsumeParen();
if(!ConsumeIfPresent(tok::colon)) {
StartingPoint = ParseExpectedFollowupExpression("(");
if(StartingPoint.isInvalid())
SkipUntil(tok::colon, true, true);
Loc = Tok.getLocation();
if(!ExpectAndConsume(tok::colon, 0, "", tok::r_paren))
goto done;
}
if(!ConsumeIfPresent(tok::r_paren)) {
EndPoint = ParseExpectedFollowupExpression(":");
if(EndPoint.isInvalid())
SkipUntil(tok::r_paren, true, true);
ExpectAndConsume(tok::r_paren, 0, "", tok::r_paren);
}
done:
return Actions.ActOnSubstringExpr(Context, Loc, Target.get(),
StartingPoint.get(), EndPoint.get());
}
// FIXME: fixed-form THENconstructname
Parser::StmtResult Parser::ParseElseIfStmt() {
auto Loc = ConsumeToken();
ExprResult Condition;
if (!ExpectAndConsume(tok::l_paren, diag::err_expected_lparen_after, "ELSE IF"))
goto error;
Condition = ParseExpectedFollowupExpression("(");
if(Condition.isInvalid()) {
if(!SkipUntil(tok::r_paren, true, true))
goto error;
}
if (!ExpectAndConsume(tok::r_paren)) goto error;
if (!ExpectAndConsumeFixedFormAmbiguous(tok::kw_THEN, diag::err_expected_kw, "THEN"))
goto error;
ParseTrailingConstructName();
return Actions.ActOnElseIfStmt(Context, Loc, Condition, StmtConstructName, StmtLabel);
error:
SkipUntilNextStatement();
return Actions.ActOnElseIfStmt(Context, Loc, Condition, StmtConstructName, StmtLabel);
}
/// ParseFunctionCallArgumentList - Parses an argument list to a call expression.
ExprResult Parser::ParseFunctionCallArgumentList(SmallVectorImpl<Expr*> &Args, SourceLocation &RParenLoc) {
if(!ExpectAndConsume(tok::l_paren))
return ExprError();
RParenLoc = getExpectedLoc();
if(ConsumeIfPresent(tok::r_paren))
return ExprResult();
auto PunctuationTok = "(";
do {
if(Tok.isAtStartOfStatement())
break;
auto E = ParseExpectedFollowupExpression(PunctuationTok);
if(E.isInvalid())
SkipUntil(tok::comma, tok::r_paren, true, true);
else Args.push_back(E.get());
PunctuationTok = ",";
} while (ConsumeIfPresent(tok::comma));
RParenLoc = getExpectedLoc();
ExpectAndConsume(tok::r_paren, 0, "", tok::r_paren);
return ExprResult();
}
Parser::StmtResult Parser::ParseIfStmt() {
auto Loc = ConsumeToken();
ExprResult Condition;
if (!ExpectAndConsume(tok::l_paren, diag::err_expected_lparen_after, "IF"))
goto error;
Condition = ParseExpectedFollowupExpression("(");
if(Condition.isInvalid()) {
if(!SkipUntil(tok::r_paren, true, true))
goto error;
}
if (!ExpectAndConsume(tok::r_paren)) goto error;
if(Features.FixedForm && !Tok.isAtStartOfStatement())
ReLexAmbiguousIdentifier(FixedFormAmbiguities.getMatcherForKeywordsAfterIF());
if (!ConsumeIfPresent(tok::kw_THEN)) {
// if-stmt
if(Tok.isAtStartOfStatement()) {
Diag.Report(getExpectedLoc(), diag::err_expected_executable_stmt);
return StmtError();
}
auto Result = Actions.ActOnIfStmt(Context, Loc, Condition, StmtConstructName, StmtLabel);
if(Result.isInvalid()) return Result;
// NB: Don't give the action stmt my label
StmtLabel = nullptr;
auto Action = ParseActionStmt();
Actions.ActOnEndIfStmt(Context, Loc, ConstructName(SourceLocation(), nullptr), nullptr);
return Action.isInvalid()? StmtError() : Result;
}
// if-construct.
return Actions.ActOnIfStmt(Context, Loc, Condition, StmtConstructName, StmtLabel);
error:
SkipUntilNextStatement();
return Actions.ActOnIfStmt(Context, Loc, Condition, StmtConstructName, StmtLabel);
}
// ParsePrimaryExpr - Parse a primary expression.
//
// [R701]:
// primary :=
// constant
// or designator
// or array-constructor
// or structure-constructor
// or function-reference
// or type-param-inquiry
// or type-param-name
// or ( expr )
Parser::ExprResult Parser::ParsePrimaryExpr(bool IsLvalue) {
ExprResult E;
SourceLocation Loc = Tok.getLocation();
// FIXME: Add rest of the primary expressions.
switch (Tok.getKind()) {
default:
if (isTokenIdentifier())
goto possible_keyword_as_ident;
Diag.Report(getExpectedLoc(), diag::err_expected_expression);
return ExprError();
case tok::error:
Lex();
return ExprError();
case tok::l_paren: {
ConsumeParen();
E = ParseExpression();
// complex constant.
if(ConsumeIfPresent(tok::comma)) {
if(E.isInvalid()) return E;
auto ImPart = ParseExpectedFollowupExpression(",");
if(ImPart.isInvalid()) return ImPart;
E = Actions.ActOnComplexConstantExpr(Context, Loc,
getMaxLocationOfCurrentToken(),
E, ImPart);
}
ExpectAndConsume(tok::r_paren, 0, "", tok::r_paren);
break;
}
case tok::l_parenslash : {
return ParseArrayConstructor();
break;
}
case tok::logical_literal_constant: {
std::string NumStr;
CleanLiteral(Tok, NumStr);
StringRef Data(NumStr);
std::pair<StringRef, StringRef> StrPair = Data.split('_');
E = LogicalConstantExpr::Create(Context, getTokenRange(),
StrPair.first, Context.LogicalTy);
SetKindSelector(cast<ConstantExpr>(E.get()), StrPair.second);
ConsumeToken();
break;
}
case tok::binary_boz_constant:
case tok::octal_boz_constant:
case tok::hex_boz_constant: {
std::string NumStr;
CleanLiteral(Tok, NumStr);
StringRef Data(NumStr);
std::pair<StringRef, StringRef> StrPair = Data.split('_');
E = BOZConstantExpr::Create(Context, Loc,
getMaxLocationOfCurrentToken(),
StrPair.first);
SetKindSelector(cast<ConstantExpr>(E.get()), StrPair.second);
ConsumeToken();
break;
}
case tok::char_literal_constant: {
std::string NumStr;
CleanLiteral(Tok, NumStr);
E = CharacterConstantExpr::Create(Context, getTokenRange(),
StringRef(NumStr), Context.CharacterTy);
ConsumeToken();
// Possible substring
if(IsPresent(tok::l_paren))
return ParseSubstring(E);
break;
}
case tok::int_literal_constant: {
std::string NumStr;
CleanLiteral(Tok, NumStr);
StringRef Data(NumStr);
std::pair<StringRef, StringRef> StrPair = Data.split('_');
E = IntegerConstantExpr::Create(Context, getTokenRange(),
StrPair.first);
SetKindSelector(cast<ConstantExpr>(E.get()), StrPair.second);
Lex();
break;
}
case tok::real_literal_constant: {
std::string NumStr;
CleanLiteral(Tok, NumStr);
StringRef Data(NumStr);
std::pair<StringRef, StringRef> StrPair = Data.split('_');
E = RealConstantExpr::Create(Context, getTokenRange(),
NumStr, Context.RealTy);
SetKindSelector(cast<ConstantExpr>(E.get()), StrPair.second);
ConsumeToken();
break;
}
case tok::double_precision_literal_constant: {
std::string NumStr;
CleanLiteral(Tok, NumStr);
// Replace the d/D exponent into e exponent
for(size_t I = 0, Len = NumStr.length(); I < Len; ++I) {
if(NumStr[I] == 'd' || NumStr[I] == 'D') {
NumStr[I] = 'e';
break;
} else if(NumStr[I] == '_') break;
}
StringRef Data(NumStr);
std::pair<StringRef, StringRef> StrPair = Data.split('_');
E = RealConstantExpr::Create(Context, getTokenRange(),
NumStr, Context.DoublePrecisionTy);
SetKindSelector(cast<ConstantExpr>(E.get()), StrPair.second);
ConsumeToken();
break;
}
case tok::identifier:
possible_keyword_as_ident:
E = Parser::ParseDesignator(IsLvalue);
if (E.isInvalid()) return E;
break;
case tok::minus:
Lex();
E = Parser::ParsePrimaryExpr();
if (E.isInvalid()) return E;
E = Actions.ActOnUnaryExpr(Context, Loc, UnaryExpr::Minus, E);
break;
case tok::plus:
Lex();
E = Parser::ParsePrimaryExpr();
if (E.isInvalid()) return E;
E = Actions.ActOnUnaryExpr(Context, Loc, UnaryExpr::Plus, E);
break;
}
return E;
}
/// ParseDeclarationTypeSpec - Parse a declaration type spec construct.
///
/// [R502]:
/// declaration-type-spec :=
/// intrinsic-type-spec
/// or TYPE ( derived-type-spec )
/// or CLASS ( derived-type-spec )
/// or CLASS ( * )
bool Parser::ParseDeclarationTypeSpec(DeclSpec &DS, bool AllowSelectors,
bool AllowOptionalCommaAfterCharLength) {
// [R403]:
// intrinsic-type-spec :=
// INTEGER [ kind-selector ]
// or REAL [ kind-selector ]
// or DOUBLE PRECISION
// or COMPLEX [ kind-selector ]
// or DOUBLE COMPLEX
// or CHARACTER [ char-selector ]
// or BYTE
// or LOGICAL [ kind-selector ]
switch (Tok.getKind()) {
default:
DS.SetTypeSpecType(DeclSpec::TST_unspecified);
break;
case tok::kw_INTEGER:
DS.SetTypeSpecType(DeclSpec::TST_integer);
break;
case tok::kw_REAL:
DS.SetTypeSpecType(DeclSpec::TST_real);
break;
case tok::kw_COMPLEX:
DS.SetTypeSpecType(DeclSpec::TST_complex);
break;
case tok::kw_CHARACTER:
DS.SetTypeSpecType(DeclSpec::TST_character);
break;
case tok::kw_BYTE:
DS.SetTypeSpecType(DeclSpec::TST_logical);
DS.setByte(); // equivalent to Kind = 1
break;
case tok::kw_LOGICAL:
DS.SetTypeSpecType(DeclSpec::TST_logical);
break;
case tok::kw_DOUBLEPRECISION:
DS.SetTypeSpecType(DeclSpec::TST_real);
DS.setDoublePrecision(); // equivalent to Kind = 8
break;
case tok::kw_DOUBLECOMPLEX:
DS.SetTypeSpecType(DeclSpec::TST_complex);
DS.setDoublePrecision(); // equivalent to Kind = 8
break;
}
if (DS.getTypeSpecType() == DeclSpec::TST_unspecified)
if (ParseTypeOrClassDeclTypeSpec(DS))
return true;
ExprResult Kind;
ExprResult Len;
// FIXME: no Kind for double complex, double precision and byte
switch (DS.getTypeSpecType()) {
case DeclSpec::TST_struct:
break;
default:
ConsumeToken();
if (ConsumeIfPresent(tok::star)) {
// FIXME: proper obsolete COMPLEX*16 support
ConsumeAnyToken();
DS.setDoublePrecision();
}
if (!AllowSelectors)
break;
if (ConsumeIfPresent(tok::l_paren)) {
Kind = ParseSelector(true);
if (Kind.isInvalid())
return true;
if(!ExpectAndConsume(tok::r_paren, 0, "", tok::r_paren))
return true;
}
break;
case DeclSpec::TST_character:
// [R424]:
// char-selector :=
// length-selector
// or ( LEN = type-param-value , KIND = scalar-int-initialization-expr )
// or ( type-param-value , #
// # [ KIND = ] scalar-int-initialization-expr )
// or ( KIND = scalar-int-initialization-expr [, LEN = type-param-value])
//
// [R425]:
// length-selector :=
// ( [ LEN = ] type-param-value )
// or * char-length [,]
//
// [R426]:
// char-length :=
// ( type-param-value )
// or scalar-int-literal-constant
//
// [R402]:
// type-param-value :=
// scalar-int-expr
// or *
// or :
ConsumeToken();
if(ConsumeIfPresent(tok::star)) {
ParseCharacterStarLengthSpec(DS);
if(AllowOptionalCommaAfterCharLength)
ConsumeIfPresent(tok::comma);
} else {
if (!AllowSelectors)
break;
if(ConsumeIfPresent(tok::l_paren)) {
if(IsPresent(tok::kw_LEN)) {
Len = ParseSelector(false);
if (Len.isInvalid())
return true;
} else if(IsPresent(tok::kw_KIND)) {
Kind = ParseSelector(true);
if (Kind.isInvalid())
return true;
} else {
Len = ParseExpectedFollowupExpression("(");
if(Len.isInvalid())
return true;
}
if(ConsumeIfPresent(tok::comma)) {
// FIXME:
if (Tok.is(tok::kw_LEN)) {
if (Len.isInvalid())
return Diag.ReportError(Tok.getLocation(),
"multiple LEN selectors for this type");
Len = ParseSelector(false);
if (Len.isInvalid())
return true;
} else if (Tok.is(tok::kw_KIND)) {
if (Kind.isInvalid())
return Diag.ReportError(Tok.getLocation(),
"multiple KIND selectors for this type");
Kind = ParseSelector(true);
if (Kind.isInvalid())
return true;
} else {
if (Kind.isInvalid())
return Diag.ReportError(Tok.getLocation(),
"multiple KIND selectors for this type");
ExprResult KindExpr = ParseExpression();
Kind = KindExpr;
}
}
if(!ExpectAndConsume(tok::r_paren))
return true;
}
}
break;
}
// Set the selectors for declspec.
if(Kind.isUsable()) DS.setKindSelector(Kind.get());
if(Len.isUsable()) DS.setLengthSelector(Len.get());
return false;
}
