Support BYTE type in declarations

13 files changed, 62 insertions, 14 deletions

diff --git a/include/flang/AST/ASTContext.h b/include/flang/AST/ASTContext.h
index cff497ca2b..d08d9215a3 100644
--- a/include/flang/AST/ASTContext.h
+++ b/include/flang/AST/ASTContext.h
@@ -96,6 +96,7 @@ public:
   QualType RealTy;
   QualType DoublePrecisionTy;
   QualType LogicalTy;
+  QualType ByteTy;
   QualType ComplexTy;
   QualType DoubleComplexTy;
   QualType CharacterTy;
@@ -111,6 +112,10 @@ public:
     return T->getBuiltinTypeKind() == DoubleComplexTy->getBuiltinTypeKind();
   }
 
+  bool isTypeByte(QualType T) const {
+    return T->getBuiltinTypeKind() == ByteTy->getBuiltinTypeKind();
+  }
+
   //===--------------------------------------------------------------------===//
   //                           Type Constructors
   //===--------------------------------------------------------------------===//
@@ -124,7 +129,8 @@ public:
   BuiltinType *getBuiltinType(BuiltinType::TypeSpec TS,
                               BuiltinType::TypeKind Kind,
                               bool IsKindExplicitlySpecified = false,
-                              bool IsDoublePrecisionKindSpecified = false);
+                              bool IsDoublePrecisionKindSpecified = false,
+                              bool IsByteKindSpecified = false);
 
   /// getComplexTypeElementType - Returns the type of an element in a complex pair.
   QualType getComplexTypeElementType(QualType Type);
diff --git a/include/flang/AST/Type.h b/include/flang/AST/Type.h
index 75400901a1..35099abfb8 100644
--- a/include/flang/AST/Type.h
+++ b/include/flang/AST/Type.h
@@ -512,6 +512,7 @@ protected:
   unsigned BuiltinTypeBitsKind : 8;
   unsigned BuiltinTypeKindSpecified : 1;
   unsigned BuiltinTypeDoublePrecisionKindSpecified : 1;
+  unsigned BuiltinTypeByteKindSpecified : 1;
 
   Type *this_() { return this; }
   Type(TypeClass TC, QualType Canon)
@@ -592,12 +593,14 @@ private:
   friend class ASTContext;      // ASTContext creates these.
   BuiltinType(TypeSpec TS, TypeKind K,
               bool IsKindSpecified,
-              bool IsDoublePrecisionKindSpecified)
+              bool IsDoublePrecisionKindSpecified,
+              bool IsByteKindSpecified)
     : Type(Builtin, QualType()) {
     BuiltinTypeBitsSpec = TS;
     BuiltinTypeBitsKind = K;
     BuiltinTypeKindSpecified = IsKindSpecified? 1: 0;
     BuiltinTypeDoublePrecisionKindSpecified = IsDoublePrecisionKindSpecified? 1: 0;
+    BuiltinTypeByteKindSpecified = IsByteKindSpecified? 1: 0;
   }
 public:
   TypeSpec getTypeSpec() const { return TypeSpec(BuiltinTypeBitsSpec); }
@@ -610,6 +613,10 @@ public:
     return BuiltinTypeDoublePrecisionKindSpecified != 0;
   }
 
+  bool isByteKindSpecified() const {
+    return BuiltinTypeByteKindSpecified != 0;
+  }
+
   bool isIntegerType() const {
     return getTypeSpec() == Integer;
   }
@@ -637,16 +644,19 @@ public:
   void Profile(llvm::FoldingSetNodeID &ID) {
     Profile(ID, getTypeSpec(), getBuiltinTypeKind(),
             isKindExplicitlySpecified(),
-            isDoublePrecisionKindSpecified());
+            isDoublePrecisionKindSpecified(),
+            isByteKindSpecified());
   }
   static void Profile(llvm::FoldingSetNodeID &ID,
                       TypeSpec Spec, TypeKind Kind,
                       bool KindSpecified,
-                      bool DoublePrecisionKindSpecified) {
+                      bool DoublePrecisionKindSpecified,
+                      bool ByteKindSpecified) {
     ID.AddInteger(Spec);
     ID.AddInteger(Kind);
     ID.AddBoolean(KindSpecified);
     ID.AddBoolean(DoublePrecisionKindSpecified);
+    ID.AddBoolean(ByteKindSpecified);
   }
 
   static bool classof(const Type *T) { return T->getTypeClass() == Builtin; }
diff --git a/include/flang/Basic/TokenKinds.def b/include/flang/Basic/TokenKinds.def
index ac70f7cdad..4d2dfe4339 100644
--- a/include/flang/Basic/TokenKinds.def
+++ b/include/flang/Basic/TokenKinds.def
@@ -136,6 +136,7 @@ KEYWORD(DO                     , KEYALL)
 KEYWORD(WHILE        , KEYALL)
 KEYWORD(INTEGER                , KEYALL)
 KEYWORD(CHARACTER              , KEYALL)
+KEYWORD(BYTE                   , KEYALL)
 KEYWORD(REAL                   , KEYALL) // A function based on context.
 KEYWORD(DOUBLE                 , KEYALL)
 KEYWORD(PRECISION              , KEYALL)
diff --git a/include/flang/Sema/DeclSpec.h b/include/flang/Sema/DeclSpec.h
index 6eaac2fb16..b38676ecef 100644
--- a/include/flang/Sema/DeclSpec.h
+++ b/include/flang/Sema/DeclSpec.h
@@ -84,6 +84,7 @@ private:
   /*IS*/ unsigned IntentSpec     : 3;
   /*AC*/ unsigned AccessSpec     : 3;
   unsigned IsDoublePrecision     : 1; // can apply to reals or complex
+  unsigned IsByte                : 1; // Logical is BYTE type
   unsigned IsStarLength          : 1; // LEN = *
 
   /// \brief The kind and length selectors.
@@ -98,7 +99,7 @@ public:
       AttributeSpecs(AS_unspecified),
       IntentSpec(IS_unspecified),
       AccessSpec(AC_unspecified),
-      IsDoublePrecision(0), IsStarLength(0),
+      IsDoublePrecision(0), IsByte(0), IsStarLength(0),
       Kind(0), Len(0),
       Record(nullptr) {}
   virtual ~DeclSpec();
@@ -106,6 +107,9 @@ public:
   bool isDoublePrecision() const { return IsDoublePrecision == 1; }
   void setDoublePrecision() { IsDoublePrecision = 1; }
 
+  bool isByte() const { return IsByte == 1; }
+  void setByte() { IsByte = 1; }
+
   bool hasKindSelector() const { return Kind != 0; }
   Expr *getKindSelector() const { return Kind; }
   void setKindSelector(Expr *K) { Kind = K; }
diff --git a/include/flang/Sema/Sema.h b/include/flang/Sema/Sema.h
index 8bd23cbe1c..7b5cb742c6 100644
--- a/include/flang/Sema/Sema.h
+++ b/include/flang/Sema/Sema.h
@@ -557,6 +557,9 @@ public:
   /// Returns true if a type is a double precision complex type.
   bool IsTypeDoublePrecisionComplex(QualType T) const;
 
+  /// Returns true if a type is a byte type.
+  bool IsTypeByte(QualType T) const;
+
   /// GetUnaryReturnType - Returns the type T with the
   /// required qualifiers and array type from the given expression.
   QualType GetUnaryReturnType(const Expr *E, QualType T);
diff --git a/lib/AST/ASTContext.cpp b/lib/AST/ASTContext.cpp
index eda8d1d35a..21eb32cd8a 100644
--- a/lib/AST/ASTContext.cpp
+++ b/lib/AST/ASTContext.cpp
@@ -36,6 +36,7 @@ void ASTContext::InitBuiltinTypes() {
   VoidTy = QualType(new (*this, TypeAlignment) VoidType(), 0);
 
   auto Opts = getLangOpts();
+  auto ByteKind = Type::Int1;
   auto IntKind = Opts.DefaultInt8? Type::Int8 : Type::Int4;
   auto RealKind = Opts.DefaultReal8? Type::Real8 : Type::Real4;
   auto DblKind = Type::Real8;
@@ -53,6 +54,8 @@ void ASTContext::InitBuiltinTypes() {
                                             false, true), 0);
 
   LogicalTy = QualType(getBuiltinType(BuiltinType::Logical, IntKind), 0);
+  ByteTy = QualType(getBuiltinType(BuiltinType::Logical, ByteKind,
+                                   false, false, true), 0);
 
   CharacterTy = QualType(getCharacterType(1), 0);
   NoLengthCharacterTy = QualType(getCharacterType(0), 0);
@@ -133,7 +136,8 @@ QualType ASTContext::getQualTypeOtherKind(QualType Type, QualType KindType) {
   auto Split = Type.split();
   return getExtQualType(getBuiltinType(BTy->getTypeSpec(), DesiredBTy->getBuiltinTypeKind(),
                                        DesiredBTy->isKindExplicitlySpecified(),
-                                       DesiredBTy->isDoublePrecisionKindSpecified()), Split.second);
+                                       DesiredBTy->isDoublePrecisionKindSpecified(),
+                                       DesiredBTy->isByteKindSpecified()), Split.second);
 }
 
 // NB: this assumes that real and complex have have the same default kind.
@@ -159,17 +163,20 @@ QualType ASTContext::getTypeWithQualifers(QualType Type, Qualifiers Quals) {
 BuiltinType *ASTContext::getBuiltinType(BuiltinType::TypeSpec TS,
                                         BuiltinType::TypeKind Kind,
                                         bool IsKindExplicitlySpecified,
-                                        bool IsDoublePrecisionKindSpecified) {
+                                        bool IsDoublePrecisionKindSpecified,
+                                        bool IsByteKindSpecified) {
   llvm::FoldingSetNodeID ID;
   BuiltinType::Profile(ID, TS, Kind, IsKindExplicitlySpecified,
-                       IsDoublePrecisionKindSpecified);
+                       IsDoublePrecisionKindSpecified,
+                       IsByteKindSpecified);
 
   void *InsertPos = 0;
   if (auto BT = BuiltinTypes.FindNodeOrInsertPos(ID, InsertPos))
     return BT;
 
   auto BT = new (*this, TypeAlignment) BuiltinType(TS, Kind, IsKindExplicitlySpecified,
-                                                   IsDoublePrecisionKindSpecified);
+                                                   IsDoublePrecisionKindSpecified,
+                                                   IsByteKindSpecified);
   Types.push_back(BT);
   BuiltinTypes.InsertNode(BT, InsertPos);
   return BT;
diff --git a/lib/AST/ASTDumper.cpp b/lib/AST/ASTDumper.cpp
index eec7e82944..ddc57e8453 100644
--- a/lib/AST/ASTDumper.cpp
+++ b/lib/AST/ASTDumper.cpp
@@ -283,6 +283,8 @@ void ASTDumper::VisitBuiltinType(const BuiltinType *T, Qualifiers QS) {
     if(T->isRealType())
       OS << "double precision";
     else OS << "double complex";
+  } else if(T->isByteKindSpecified()) {
+    OS << "byte";
   } else {
     switch (T->getTypeSpec()) {
     default: assert(false && "Invalid built-in type!");
diff --git a/lib/Parse/FixedForm.cpp b/lib/Parse/FixedForm.cpp
index 15469c10f0..4575c575fd 100644
--- a/lib/Parse/FixedForm.cpp
+++ b/lib/Parse/FixedForm.cpp
@@ -108,7 +108,8 @@ static const tok::TokenKind AmbiguousTypeKeywords[] = {
   tok::kw_DOUBLEPRECISION,
   tok::kw_DOUBLECOMPLEX,
   tok::kw_LOGICAL,
-  tok::kw_CHARACTER
+  tok::kw_CHARACTER,
+  tok::kw_BYTE
 };
 
 AmbiguousTypeStatements::AmbiguousTypeStatements()
diff --git a/lib/Parse/ParseDecl.cpp b/lib/Parse/ParseDecl.cpp
index 68d0be160e..9e626637a3 100644
--- a/lib/Parse/ParseDecl.cpp
+++ b/lib/Parse/ParseDecl.cpp
@@ -279,6 +279,7 @@ bool Parser::ParseDeclarationTypeSpec(DeclSpec &DS, bool AllowSelectors,
   //    or COMPLEX [ kind-selector ]
   //    or DOUBLE COMPLEX
   //    or CHARACTER [ char-selector ]
+  //    or BYTE
   //    or LOGICAL [ kind-selector ]
   switch (Tok.getKind()) {
   default:
@@ -296,6 +297,10 @@ bool Parser::ParseDeclarationTypeSpec(DeclSpec &DS, bool AllowSelectors,
   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;
@@ -316,7 +321,7 @@ bool Parser::ParseDeclarationTypeSpec(DeclSpec &DS, bool AllowSelectors,
   ExprResult Kind;
   ExprResult Len;
 
-  // FIXME: no Kind for double complex and double precision
+  // FIXME: no Kind for double complex, double precision and byte
   switch (DS.getTypeSpecType()) {
   case DeclSpec::TST_struct:
     break;
@@ -543,6 +548,7 @@ bool Parser::ParseDerivedTypeDefinitionStmt() {
     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:
diff --git a/lib/Parse/Parser.cpp b/lib/Parse/Parser.cpp
index bb48e7ff18..138d6cf9d6 100644
--- a/lib/Parse/Parser.cpp
+++ b/lib/Parse/Parser.cpp
@@ -602,6 +602,7 @@ bool Parser::ParseProgramUnit() {
   case tok::kw_INTEGER:
   case tok::kw_COMPLEX:
   case tok::kw_CHARACTER:
+  case tok::kw_BYTE:
   case tok::kw_LOGICAL:
   case tok::kw_DOUBLEPRECISION:
   case tok::kw_DOUBLECOMPLEX:
@@ -866,7 +867,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_TYPE))
+     Tok.is(tok::kw_BYTE) || Tok.is(tok::kw_TYPE))
     return ParseTypedExternalSubprogram(FunctionDecl::Recursive);
 
 err:
@@ -1144,6 +1145,7 @@ bool Parser::ParseDeclarationConstruct() {
   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: {
diff --git a/lib/Sema/SemaChecking.cpp b/lib/Sema/SemaChecking.cpp
index dc997f185a..f7f783edad 100644
--- a/lib/Sema/SemaChecking.cpp
+++ b/lib/Sema/SemaChecking.cpp
@@ -345,6 +345,7 @@ bool Sema::IsDefaultBuiltinOrDoublePrecisionType(QualType T) {
     return false;
   auto BTy = T->asBuiltinType();
   if(BTy->isDoublePrecisionKindSpecified() ||
+     BTy->isByteKindSpecified() ||
      !BTy->isKindExplicitlySpecified())
     return true;
   return false;
diff --git a/lib/Sema/SemaDecl.cpp b/lib/Sema/SemaDecl.cpp
index 1197cf5f48..c1d88eed1a 100644
--- a/lib/Sema/SemaDecl.cpp
+++ b/lib/Sema/SemaDecl.cpp
@@ -149,7 +149,7 @@ QualType Sema::ActOnTypeName(ASTContext &C, DeclSpec &DS) {
   if(DS.hasKindSelector())
     Kind = EvalAndCheckTypeKind(Result, DS.getKindSelector());
 
-  if(Kind != Type::NoKind || DS.isDoublePrecision()) {
+  if(Kind != Type::NoKind || DS.isDoublePrecision() || DS.isByte()) {
     switch (DS.getTypeSpecType()) {
     case DeclSpec::TST_integer:
       Result = Kind == Type::NoKind? C.IntegerTy :
@@ -160,7 +160,7 @@ QualType Sema::ActOnTypeName(ASTContext &C, DeclSpec &DS) {
                          QualType(C.getBuiltinType(BuiltinType::Real, Kind, true), 0);
       break;
     case DeclSpec::TST_logical:
-      Result = Kind == Type::NoKind? C.LogicalTy :
+      Result = Kind == Type::NoKind? (DS.isByte()? C.ByteTy : C.LogicalTy) :
                          QualType(C.getBuiltinType(BuiltinType::Logical, Kind, true), 0);
       break;
     case DeclSpec::TST_complex:
diff --git a/lib/Sema/SemaExpr.cpp b/lib/Sema/SemaExpr.cpp
index 4f955aaf09..4dc9d76bd1 100644
--- a/lib/Sema/SemaExpr.cpp
+++ b/lib/Sema/SemaExpr.cpp
@@ -28,6 +28,11 @@ bool Sema::IsTypeDoublePrecisionComplex(QualType T) const {
   return T->isComplexType() && Context.isTypeDoubleComplex(T);
 }
 
+/// Returns true if a type is a byte type.
+bool Sema::IsTypeByte(QualType T) const {
+  return Context.isTypeByte(T);
+}
+
 /// Returns TST_integer/TST_real/TST_complex if a given type
 /// is an arithmetic type, or TST_unspecified otherwise
 static TypeSpecifierType GetArithmeticTypeSpec(QualType T) {