Parser::StmtResult Parser::ParseWriteStmt() {
SourceLocation Loc = ConsumeToken();
// clist
if(!ExpectAndConsume(tok::l_paren))
return StmtError();
UnitSpec *US = nullptr;
FormatSpec *FS = nullptr;
US = ParseUNITSpec(false);
if(ConsumeIfPresent(tok::comma)) {
bool IsFormatLabeled = false;
if(ConsumeIfPresent(tok::kw_FMT)) {
if(!ExpectAndConsume(tok::equal))
return StmtError();
IsFormatLabeled = true;
}
FS = ParseFMTSpec(IsFormatLabeled);
}
if(!ExpectAndConsume(tok::r_paren))
return StmtError();
// iolist
SmallVector<ExprResult, 4> OutputItemList;
ParseIOList(OutputItemList);
return Actions.ActOnWriteStmt(Context, Loc, US, FS, OutputItemList, StmtLabel);
}
/// 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);
}
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;
}
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);
}
bool Parser::ParseDerivedTypeComponentStmt() {
// type-spec
DeclSpec DS;
if(ParseDeclarationTypeSpec(DS, true, false))
return true;
// component-attr-spec
if(ConsumeIfPresent(tok::comma)) {
do {
auto Kind = Tok.getKind();
auto Loc = Tok.getLocation();
auto ID = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier))
return true;
if(Kind == tok::kw_POINTER)
Actions.ActOnAttrSpec(Loc, DS, DeclSpec::AS_pointer);
else if(Kind == tok::kw_DIMENSION) {
if(ParseDimensionAttributeSpec(Loc, DS))
return true;
} else {
if(isAttributeSpec(Kind))
Diag.Report(Loc, diag::err_use_of_attr_spec_in_type_decl)
<< ID;
else
Diag.Report(Loc, diag::err_expected_attr_spec);
if(!SkipUntil(tok::coloncolon, true, true))
return true;
break;
}
} while(ConsumeIfPresent(tok::comma));
if(!ExpectAndConsume(tok::coloncolon))
return true;
} else
ConsumeIfPresent(tok::coloncolon);
// component-decl-list
do {
auto IDLoc = Tok.getLocation();
auto ID = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier))
return true;
DeclSpec ObjectDS(DS);
if(ParseObjectArraySpec(IDLoc, ObjectDS))
return true;
if(ParseObjectCharLength(IDLoc, ObjectDS))
return true;
// FIXME: initialization expressions
Actions.ActOnDerivedTypeFieldDecl(Context, ObjectDS, IDLoc, ID);
} while(ConsumeIfPresent(tok::comma));
return false;
}
Parser::StmtResult Parser::ParseGotoStmt() {
SourceLocation Loc = ConsumeToken();
if(ConsumeIfPresent(tok::l_paren)) {
// computed goto.
SmallVector<Expr*, 4> Targets;
do {
auto E = ParseStatementLabelReference();
if(E.isInvalid()) break;
Targets.append(1, E.get());
} while(ConsumeIfPresent(tok::comma));
ExprResult Operand;
bool ParseOperand = true;
if(!ExpectAndConsume(tok::r_paren)) {
if(!SkipUntil(tok::r_paren)) ParseOperand = false;
}
if(ParseOperand) Operand = ParseExpectedExpression();
return Actions.ActOnComputedGotoStmt(Context, Loc, Targets, Operand, StmtLabel);
}
auto Destination = ParseStatementLabelReference();
if(Destination.isInvalid()) {
if(!IsPresent(tok::identifier)) {
Diag.Report(getExpectedLoc(), diag::err_expected_stmt_label_after)
<< "GO TO";
return StmtError();
}
auto IDInfo = Tok.getIdentifierInfo();
auto IDLoc = ConsumeToken();
auto VD = Actions.ExpectVarRef(IDLoc, IDInfo);
if(!VD) return StmtError();
auto Var = VarExpr::Create(Context, IDLoc, VD);
// Assigned goto
SmallVector<Expr*, 4> AllowedValues;
if(ConsumeIfPresent(tok::l_paren)) {
do {
auto E = ParseStatementLabelReference();
if(E.isInvalid()) {
Diag.Report(getExpectedLoc(), diag::err_expected_stmt_label);
SkipUntilNextStatement();
return Actions.ActOnAssignedGotoStmt(Context, Loc, Var, AllowedValues, StmtLabel);
}
AllowedValues.append(1, E.get());
} while(ConsumeIfPresent(tok::comma));
ExpectAndConsume(tok::r_paren);
}
return Actions.ActOnAssignedGotoStmt(Context, Loc, Var, AllowedValues, StmtLabel);
}
// Uncoditional goto
return Actions.ActOnGotoStmt(Context, Loc, Destination, 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);
}
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);
}
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);
}
Parser::StmtResult Parser::ParseAssignStmt() {
SourceLocation Loc = ConsumeToken();
auto Value = ParseStatementLabelReference(false);
if(Value.isInvalid()) {
Diag.Report(getExpectedLoc(), diag::err_expected_stmt_label_after)
<< "ASSIGN";
return StmtError();
}
ConsumeToken();
if(!ExpectAndConsumeFixedFormAmbiguous(tok::kw_TO, diag::err_expected_kw, "to"))
return StmtError();
auto IDInfo = Tok.getIdentifierInfo();
auto IDRange = getTokenRange();
auto IDLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::identifier))
return StmtError();
auto VD = Actions.ExpectVarRefOrDeclImplicitVar(IDLoc, IDInfo);
if(!VD)
return StmtError();
auto Var = VarExpr::Create(Context, IDRange, VD);
return Actions.ActOnAssignStmt(Context, Loc, Value, Var, StmtLabel);
}
/// FIXME: todo implied-do
ExprResult Parser::ParseArrayConstructor() {
auto Loc = ConsumeParenSlash();
SourceLocation EndLoc = Tok.getLocation();
SmallVector<Expr*, 16> ExprList;
if(ConsumeIfPresent(tok::slashr_paren))
return Actions.ActOnArrayConstructorExpr(Context, Loc, EndLoc, ExprList);
do {
auto E = ParseExpectedExpression();
if(E.isInvalid())
goto error;
if(E.isUsable())
ExprList.push_back(E.get());
} while(ConsumeIfPresent(tok::comma));
EndLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::slashr_paren))
goto error;
return Actions.ActOnArrayConstructorExpr(Context, Loc, EndLoc, ExprList);
error:
EndLoc = Tok.getLocation();
SkipUntil(tok::slashr_paren);
return Actions.ActOnArrayConstructorExpr(Context, Loc, EndLoc, ExprList);
}
/// ParseWHEREStmt - Parse the WHERE statement.
///
/// [R743]:
/// where-stmt :=
/// WHERE ( mask-expr ) where-assignment-stmt
Parser::StmtResult Parser::ParseWhereStmt() {
auto Loc = ConsumeToken();
ExpectAndConsume(tok::l_paren);
auto Mask = ParseExpectedExpression();
if(!Mask.isInvalid())
ExpectAndConsume(tok::r_paren);
else SkipUntil(tok::r_paren);
if(!Tok.isAtStartOfStatement()) {
auto Label = StmtLabel;
StmtLabel = nullptr;
auto Body = ParseActionStmt();
if(Body.isInvalid())
return Body;
return Actions.ActOnWhereStmt(Context, Loc, Mask, Body, Label);
}
return Actions.ActOnWhereStmt(Context, Loc, Mask, StmtLabel);
}
/// ParseStructureComponent - Parse a structure component.
///
/// R613:
/// structure-component :=
/// designator % data-ref
ExprResult Parser::ParseStructureComponent(ExprResult Target) {
auto Loc = ConsumeToken();
auto ID = Tok.getIdentifierInfo();
auto IDLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::identifier))
return ExprError();
return Actions.ActOnStructureComponentExpr(Context, Loc, IDLoc, ID,
Target.get());
}
/// ParseTypeOrClassDeclTypeSpec - Parse a TYPE(...) or CLASS(...) declaration
/// type spec.
///
/// [R502]:
/// declaration-type-spec :=
/// TYPE ( derived-type-spec )
/// or CLASS ( derived-type-spec )
/// or CLASS ( * )
///
/// [R455]:
/// derived-type-spec :=
/// type-name [ ( type-param-spec-list ) ]
///
/// [R456]:
/// type-param-spec :=
/// [ keyword = ] type-param-value
bool Parser::ParseTypeOrClassDeclTypeSpec(DeclSpec &DS) {
if(Tok.is(tok::kw_TYPE)) {
ConsumeToken();
if(!ExpectAndConsume(tok::l_paren))
return true;
auto ID = Tok.getIdentifierInfo();
auto Loc = Tok.getLocation();
if(!ExpectAndConsume(tok::identifier))
return true;
if(!ExpectAndConsume(tok::r_paren))
return true;
Actions.ActOnTypeDeclSpec(Context, Loc, ID, DS);
return false;
}
// FIXME: Handle CLASS.
return true;
}
/// Parse the optional KIND or LEN selector.
///
/// [R405]:
/// kind-selector :=
/// ( [ KIND = ] scalar-int-initialization-expr )
/// [R425]:
/// length-selector :=
/// ( [ LEN = ] type-param-value )
ExprResult Parser::ParseSelector(bool IsKindSel) {
if (ConsumeIfPresent(IsKindSel ? tok::kw_KIND : tok::kw_LEN)) {
if (!ExpectAndConsume(tok::equal))
return ExprError();
// TODO: We have a "REAL (KIND(10D0)) :: x" situation.
}
return ParseExpression();
}
// 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);
}
// FIXME: Fortran 2008 stuff.
/// ParseDerivedTypeDefinitionStmt - Parse a type or a class definition.
///
/// [R422]:
/// derived-type-def :=
/// derived-type-stmt
/// [ private-sequence-stmt ] ...
/// component-def-stmt
/// [ component-def-stmt ] ...
/// end-type-stmt
///
/// [R423]:
/// derived-type-stmt :=
/// TYPE [ [ , access-spec ] :: ] type-name
///
/// [R424]:
/// private-sequence-stmt :=
/// PRIVATE or SEQUENCE
///
/// [R425]:
/// component-def-stmt :=
/// type-spec [ [ component-attr-spec-list ] :: ] component-decl-list
///
/// [R426]:
/// component-attr-spec-list :=
/// POINTER or
/// DIMENSION( component-array-spec )
///
/// [R427]:
/// component-array-spec :=
/// explicit-shape-spec-list or
/// deffered-shape-spec-list
///
/// [R428]:
/// component-decl :=
/// component-name [ ( component-array-spec ) ]
/// [ * char-length ] [ component-initialization ]
///
/// [R429]:
/// component-initialization :=
/// = initialization-expr or
/// => NULL()
///
/// [R430]:
/// end-type-stmt :=
/// END TYPE [ type-name ]
bool Parser::ParseDerivedTypeDefinitionStmt() {
bool IsClass = Tok.is(tok::kw_CLASS);
auto Loc = ConsumeToken();
if(ConsumeIfPresent(tok::comma)) {
//FIXME: access-spec
}
ConsumeIfPresent(tok::coloncolon);
auto ID = Tok.getIdentifierInfo();
auto IDLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::identifier)) {
SkipUntilNextStatement();
return true;
} else
ExpectStatementEnd();
Actions.ActOnDerivedTypeDecl(Context, Loc, IDLoc, ID);
// FIXME: private
if(Tok.is(tok::kw_SEQUENCE)) {
Actions.ActOnDerivedTypeSequenceStmt(Context, ConsumeToken());
ExpectStatementEnd();
}
bool Done = false;
while(!Done) {
switch(Tok.getKind()) {
case tok::kw_TYPE:
case tok::kw_CLASS:
case tok::kw_INTEGER:
case tok::kw_REAL:
case tok::kw_COMPLEX:
case tok::kw_CHARACTER:
case tok::kw_BYTE:
case tok::kw_LOGICAL:
case tok::kw_DOUBLEPRECISION:
case tok::kw_DOUBLECOMPLEX:
if(ParseDerivedTypeComponentStmt())
SkipUntilNextStatement();
else ExpectStatementEnd();
break;
default:
Done = true;
break;
}
}
ParseEndTypeStmt();
Actions.ActOnEndDerivedTypeDecl(Context);
return false;
error:
return true;
}
Parser::StmtResult Parser::ParsePrintStmt() {
SourceLocation Loc = ConsumeToken();
FormatSpec *FS = ParseFMTSpec(false);
if(!ExpectAndConsume(tok::comma))
return StmtError();
SmallVector<ExprResult, 4> OutputItemList;
ParseIOList(OutputItemList);
return Actions.ActOnPrintStmt(Context, Loc, FS, OutputItemList, 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);
}
/// 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);
}
/// 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();
}
/// 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());
}
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);
}
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;
}
Parser::StmtResult Parser::ParseCallStmt() {
auto Loc = ConsumeToken();
SourceLocation RParenLoc = getExpectedLoc();
auto ID = Tok.getIdentifierInfo();
auto IDLoc = Tok.getLocation();
if(!ExpectAndConsume(tok::identifier))
return StmtError();
SmallVector<Expr*, 8> Arguments;
if(!Tok.isAtStartOfStatement()) {
if(ParseFunctionCallArgumentList(Arguments, RParenLoc).isInvalid())
SkipUntilNextStatement();
}
return Actions.ActOnCallStmt(Context, Loc, RParenLoc, IDLoc, ID, Arguments, StmtLabel);
}
bool Parser::ParseEntityDeclarationList(DeclSpec &DS,
SmallVectorImpl<DeclResult> &Decls) {
do {
auto IDLoc = Tok.getLocation();
auto ID = Tok.getIdentifierInfo();
if(!ExpectAndConsume(tok::identifier))
return true;
DeclSpec ObjectDS(DS);
if(ParseObjectArraySpec(IDLoc, ObjectDS))
return true;
if(ParseObjectCharLength(IDLoc, ObjectDS))
return true;
Decls.push_back(Actions.ActOnEntityDecl(Context, ObjectDS, IDLoc, ID));
} while(ConsumeIfPresent(tok::comma));
return false;
}
/// ParseArrauSubscript - Parse an Array Subscript Expression
ExprResult Parser::ParseArraySubscript(ExprResult Target) {
SmallVector<Expr*, 8> ExprList;
auto Loc = ConsumeParen();
bool IgnoreRParen = false;
auto PunctuationTok = "(";
do {
if(Tok.isAtStartOfStatement())
IgnoreRParen = true;
auto E = ParseArraySection(PunctuationTok);
if(E.isInvalid())
SkipUntil(tok::comma, tok::r_paren, true, true);
if(E.isUsable())
ExprList.push_back(E.get());
PunctuationTok = ",";
} while(ConsumeIfPresent(tok::comma));
auto RParenLoc = getExpectedLoc();
if(!IgnoreRParen)
ExpectAndConsume(tok::r_paren, 0, "", tok::r_paren);
return Actions.ActOnSubscriptExpr(Context, Loc, RParenLoc, Target.get(),
ExprList);
}
// 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;
}
/// 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);
}