Initial VAX struct implementationbenbrewer/struct

8 files changed, 101 insertions, 13 deletions

diff --git a/include/flang/Basic/DiagnosticParseKinds.td b/include/flang/Basic/DiagnosticParseKinds.td
index c30394f44b..1c61ae5150 100644
--- a/include/flang/Basic/DiagnosticParseKinds.td
+++ b/include/flang/Basic/DiagnosticParseKinds.td
@@ -22,6 +22,7 @@ def err_duplicate_len_selector : Error<
   "duplicate character length declaration specifier">;
 def err_unexpected_lparen : Error<"unexpected '('">;
 def err_unexpected_percent : Error<"unexpected '%'">;
+def err_unexpected_period : Error<"unexpected '.'">;
 
 def err_expected_expression : Error<"expected an expression">;
 def err_expected_expression_after : Error<
diff --git a/include/flang/Basic/TokenKinds.def b/include/flang/Basic/TokenKinds.def
index 4d2dfe4339..497a972df6 100644
--- a/include/flang/Basic/TokenKinds.def
+++ b/include/flang/Basic/TokenKinds.def
@@ -186,6 +186,10 @@ KEYWORD(PARAMETER              , KEYALL)    // [5.2.9]  parameter-stmt
 KEYWORD(POINTER                , KEYNOTF77) // [5.2.10] pointer-stmt
 KEYWORD(PROTECTED              , KEYNOTF77) // [5.2.11] protected-stmt
 KEYWORD(SAVE                   , KEYALL)    // [5.2.12] save-stmt
+KEYWORD(STRUCTURE              , KEYF77)
+KEYWORD(MAP                    , KEYF77)
+KEYWORD(UNION                  , KEYF77)
+KEYWORD(RECORD                 , KEYF77)
 KEYWORD(TARGET                 , KEYALL)    // [5.2.13] target-stmt
 KEYWORD(VALUE                  , KEYALL)    // [5.2.14] value-stmt
 KEYWORD(VOLATILE               , KEYALL)    // [5.2.15] volatile-stmt
@@ -212,8 +216,7 @@ KEYWORD(FORALL                 , KEYNOTF77) // [7.4.4]  forall-construct
 
 KEYWORD(FORMAT                 , KEYALL)
 
-// [???] R???
-KEYWORD(OPERATOR               , KEYALL)
+KEYWORD(OPERATOR               , KEYNOTF77) // [12.7.7] generic-spec
 
 KEYWORD(USE                    , KEYALL)    // [11.2.1] use-stmt
 KEYWORD(ONLY                   , KEYALL)    // [11.2.1] use-stmt
@@ -254,6 +257,12 @@ KEYWORD(ENDFUNCTION            , KEYALL)
 KEYWORD(ENDINTERFACE           , KEYALL)
 // END PROGRAM:
 KEYWORD(ENDPROGRAM             , KEYALL)
+// END STRUCTURE:
+KEYWORD(ENDSTRUCTURE           , KEYALL)
+// END MAP:
+KEYWORD(ENDMAP                 , KEYALL)
+// END UNION:
+KEYWORD(ENDUNION               , KEYALL)
 // END SUBPROGRAM:
 KEYWORD(ENDSUBPROGRAM          , KEYALL)
 // END SUBROUTINE:
diff --git a/include/flang/Parse/Lexer.h b/include/flang/Parse/Lexer.h
index 3b158a3d43..84c0efa545 100644
--- a/include/flang/Parse/Lexer.h
+++ b/include/flang/Parse/Lexer.h
@@ -226,6 +226,10 @@ class Lexer {
   void LexFixedFormIdentifier(const fixedForm::KeywordMatcher &Matcher,
                               Token &Tok);
 
+  /// ScanPossibleF77Operator - Determine if next characters represent
+  /// a valid Fortran77 operator, returns true if so.
+  bool ScanPossibleF77Operator();
+
   /// LexPossibleDefinedOperator - Tries to lex a defined operator
   /// that begins with '.', returns true if sucessfull.
   bool LexPossibleDefinedOperator(Token &Result);
diff --git a/include/flang/Parse/Parser.h b/include/flang/Parse/Parser.h
index f6f922b192..b498f6054d 100644
--- a/include/flang/Parse/Parser.h
+++ b/include/flang/Parse/Parser.h
@@ -556,7 +556,7 @@ private:
 
   // Declaration construct functions
   bool ParseDerivedTypeDefinitionStmt();
-  void ParseEndTypeStmt();
+  void ParseEndTypeStmt(bool IsStructure = false);
   bool ParseDerivedTypeComponentStmt();
 
   ExprResult ParseSelector(bool IsKindSel);
diff --git a/lib/Parse/Lexer.cpp b/lib/Parse/Lexer.cpp
index 201ef0a39a..e7e3dfcad2 100644
--- a/lib/Parse/Lexer.cpp
+++ b/lib/Parse/Lexer.cpp
@@ -1004,6 +1004,36 @@ void Lexer::LexFixedFormIdentifier(const fixedForm::KeywordMatcher &Matcher,
     Tok.setFlag(Token::NeedsCleaning);
 }
 
+bool Lexer::ScanPossibleF77Operator() {
+  unsigned w;
+  for (w = 1; isHorizontalWhitespace(peekNextChar(w)); w++);
+
+  char CSIdent[6] = { 0 };
+  for (unsigned i = 0; isLetter(peekNextChar(w)) && (i < 6); i++, w++)
+    CSIdent[i] = peekNextChar(w);
+  if (peekNextChar(w) != '.')
+    return false;
+
+  llvm::StringRef Ident(CSIdent);
+
+  const char* CSBuiltIn[] = {
+    "TRUE", "FALSE",
+    "EQ", "NE",
+    "LT", "LE", "GT", "GE",
+    "NOT", "AND", "OR",
+    "EQV", "NEQV", NULL
+  };
+
+  for (unsigned b = 0; CSBuiltIn[b]; b++) {
+    llvm::StringRef BuiltIn(CSBuiltIn[b]);
+
+    if (BuiltIn.compare_lower(Ident))
+      return true;
+  }
+
+  return false;
+}
+
 bool Lexer::LexPossibleDefinedOperator(Token &Result) {
   auto Char = getNextChar();
   if (Features.FixedForm) {
@@ -1291,8 +1321,16 @@ void Lexer::LexTokenInternal(Token &Result, bool IsPeekAhead) {
     return LexTokenInternal(Result, IsPeekAhead);
 
   case '.':
-    if(LexPossibleDefinedOperator(Result))
+    if ((!Features.Fortran77 || ScanPossibleF77Operator())
+      && LexPossibleDefinedOperator(Result))
       return;
+
+    if (Features.Fortran77 && !isDecimalNumberBody(peekNextChar())) {
+      Kind = tok::period;
+      break;
+    }
+
+    getNextChar();
     // FALLTHROUGH
   case '0': case '1': case '2': case '3': case '4':
   case '5': case '6': case '7': case '8': case '9':
diff --git a/lib/Parse/ParseDecl.cpp b/lib/Parse/ParseDecl.cpp
index 9cd4330614..bba96bf06a 100644
--- a/lib/Parse/ParseDecl.cpp
+++ b/lib/Parse/ParseDecl.cpp
@@ -463,6 +463,17 @@ bool Parser::ParseTypeOrClassDeclTypeSpec(DeclSpec &DS) {
       return true;
     Actions.ActOnTypeDeclSpec(Context, Loc, ID, DS);
     return false;
+  } else if(Tok.is(tok::kw_RECORD)) {
+    ConsumeToken();
+    if(!ExpectAndConsume(tok::slash))
+      return true;
+    auto ID = Tok.getIdentifierInfo();
+    auto Loc = Tok.getLocation();
+    if(!ExpectAndConsume(tok::identifier)
+      || !ExpectAndConsume(tok::slash))
+      return true;
+    Actions.ActOnTypeDeclSpec(Context, Loc, ID, DS);
+    return false;
   }
 
   // FIXME: Handle CLASS.
@@ -517,6 +528,7 @@ bool Parser::ParseTypeOrClassDeclTypeSpec(DeclSpec &DS) {
 ///     END TYPE [ type-name ]
 bool Parser::ParseDerivedTypeDefinitionStmt() {
   bool IsClass = Tok.is(tok::kw_CLASS);
+  bool IsStructure = Tok.is(tok::kw_STRUCTURE);
   auto Loc = ConsumeToken();
 
   if(ConsumeIfPresent(tok::comma)) {
@@ -524,13 +536,23 @@ bool Parser::ParseDerivedTypeDefinitionStmt() {
   }
   ConsumeIfPresent(tok::coloncolon);
 
+  if (IsStructure && !ExpectAndConsume(tok::slash)) {
+    SkipUntilNextStatement();
+    return true;
+  }
+
   auto ID = Tok.getIdentifierInfo();
   auto IDLoc = Tok.getLocation();
   if(!ExpectAndConsume(tok::identifier)) {
     SkipUntilNextStatement();
     return true;
-  } else
-    ExpectStatementEnd();
+  }
+
+  if (IsStructure && !ExpectAndConsume(tok::slash)) {
+    SkipUntilNextStatement();
+    return true;
+  }
+  ExpectStatementEnd();
 
   Actions.ActOnDerivedTypeDecl(Context, Loc, IDLoc, ID);
 
@@ -545,6 +567,7 @@ bool Parser::ParseDerivedTypeDefinitionStmt() {
     switch(Tok.getKind()) {
     case tok::kw_TYPE:
     case tok::kw_CLASS:
+    case tok::kw_RECORD:
     case tok::kw_INTEGER:
     case tok::kw_REAL:
     case tok::kw_COMPLEX:
@@ -563,7 +586,7 @@ bool Parser::ParseDerivedTypeDefinitionStmt() {
     }
   }
 
-  ParseEndTypeStmt();
+  ParseEndTypeStmt(IsStructure);
 
   Actions.ActOnEndDerivedTypeDecl(Context);
   return false;
@@ -571,12 +594,12 @@ error:
   return true;
 }
 
-void Parser::ParseEndTypeStmt() {
-  if(Tok.isNot(tok::kw_ENDTYPE)) {
+void Parser::ParseEndTypeStmt(bool IsStructure) {
+  if(Tok.isNot(IsStructure ? tok::kw_ENDSTRUCTURE : tok::kw_ENDTYPE)) {
     Diag.Report(Tok.getLocation(), diag::err_expected_kw)
-      << "end type";
+      << (IsStructure ? "end structure" : "end type");
     Diag.Report(cast<NamedDecl>(Actions.CurContext)->getLocation(), diag::note_matching)
-      << "type";
+      << (IsStructure ? "structure" : "type");
     return;
   }
 
diff --git a/lib/Parse/ParseExpr.cpp b/lib/Parse/ParseExpr.cpp
index ce78880a87..fac56e44ed 100644
--- a/lib/Parse/ParseExpr.cpp
+++ b/lib/Parse/ParseExpr.cpp
@@ -600,6 +600,14 @@ ExprResult Parser::ParseDesignator(bool IsLvalue) {
         Diag.Report(Tok.getLocation(), diag::err_unexpected_percent);
         return ExprError();
       }
+    } else if(IsPresent(tok::period)) {
+      auto EType = E.get()->getType();
+      if(EType->isRecordType())
+        E = ParseStructureComponent(E);
+      else {
+        Diag.Report(Tok.getLocation(), diag::err_unexpected_period);
+        return ExprError();
+      }
     }
     else break;
   }
@@ -908,7 +916,7 @@ ExprResult Parser::ParseDataReference() {
     ExprResult E = ParsePartReference();
     if (E.isInvalid()) return E;
     Exprs.push_back(E);
-  } while (ConsumeIfPresent(tok::percent));
+  } while (ConsumeIfPresent(tok::percent) || ConsumeIfPresent(tok::period));
 
   return Actions.ActOnDataReference(Exprs);
 }
diff --git a/lib/Parse/Parser.cpp b/lib/Parse/Parser.cpp
index 31626a6ffc..a091b8e861 100644
--- a/lib/Parse/Parser.cpp
+++ b/lib/Parse/Parser.cpp
@@ -216,6 +216,9 @@ void Parser::Lex() {
     MERGE_TOKENS(END, FILE);
     MERGE_TOKENS(END, INTERFACE);
     MERGE_TOKENS(END, BLOCKDATA);
+    MERGE_TOKENS(END, STRUCTURE);
+    MERGE_TOKENS(END, MAP);
+    MERGE_TOKENS(END, UNION);
 
     if (NextTok.is(tok::kw_BLOCK)) {
       Tok = NextTok;
@@ -868,7 +871,7 @@ bool Parser::ParseRecursiveExternalSubprogram() {
   if(Tok.is(tok::kw_INTEGER) || Tok.is(tok::kw_REAL) || Tok.is(tok::kw_COMPLEX) ||
      Tok.is(tok::kw_DOUBLEPRECISION) || Tok.is(tok::kw_DOUBLECOMPLEX) ||
      Tok.is(tok::kw_LOGICAL) || Tok.is(tok::kw_CHARACTER) ||
-     Tok.is(tok::kw_BYTE) || Tok.is(tok::kw_TYPE))
+     Tok.is(tok::kw_BYTE) || Tok.is(tok::kw_TYPE) || Tok.is(tok::kw_RECORD))
     return ParseTypedExternalSubprogram(FunctionDecl::Recursive);
 
 err:
@@ -1135,6 +1138,7 @@ bool Parser::ParseDeclarationConstruct() {
     break;
   case tok::kw_TYPE:
   case tok::kw_CLASS:
+  case tok::kw_STRUCTURE:
     if (IsNextToken(tok::equal))
       return true;
     if(!IsNextToken(tok::l_paren)) {
@@ -1142,6 +1146,7 @@ bool Parser::ParseDeclarationConstruct() {
       break;
     }
     // NB: fallthrough
+  case tok::kw_RECORD:
   case tok::kw_INTEGER:
   case tok::kw_REAL:
   case tok::kw_COMPLEX: