[flang] Support for PowerPC vector type

The following PowerPC vector type syntax is added:

  VECTOR ( element-type-spec )

where element-type-sec is integer-type-spec, real-type-sec or unsigned-type-spec.

Two opaque types (__VECTOR_PAIR and __VECTOR_QUAD) are also added.

A finite set of functionalities are implemented in order to support the new types:
1. declare objects
2. declare function result
3. declare type dummy arguments
4. intrinsic assignment between the new type objects (e.g. v1=v2)
5. reference functions that return the new types

Submit on behalf of @tislam @DanielCChen

Authors: @tislam @DanielCChen

Differential Revision: https://reviews.llvm.org/D150876

flang/include/flang/Common/Fortran-features.h

@@ -36,7 +36,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
     SaveMainProgram, SaveBigMainProgramVariables,
-    DistinctArrayConstructorLengths)
+    DistinctArrayConstructorLengths, PPCVector)
 
 // Portability and suspicious usage warnings for conforming code
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

flang/include/flang/Common/Fortran.h

@@ -21,6 +21,7 @@ namespace Fortran::common {
 
 // Fortran has five kinds of intrinsic data types, plus the derived types.
 ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived)
+ENUM_CLASS(VectorElementCategory, Integer, Unsigned, Real)
 
 constexpr bool IsNumericTypeCategory(TypeCategory category) {
   return category == TypeCategory::Integer || category == TypeCategory::Real ||

flang/include/flang/Parser/dump-parse-tree.h

@@ -715,11 +715,17 @@ class ParseTreeDumper {
   NODE(Union, EndUnionStmt)
   NODE(Union, UnionStmt)
   NODE(parser, UnlockStmt)
+  NODE(parser, UnsignedTypeSpec)
   NODE(parser, UseStmt)
   NODE_ENUM(UseStmt, ModuleNature)
   NODE(parser, Value)
   NODE(parser, ValueStmt)
   NODE(parser, Variable)
+  NODE(parser, VectorTypeSpec)
+  NODE(VectorTypeSpec, PairVectorTypeSpec)
+  NODE(VectorTypeSpec, QuadVectorTypeSpec)
+  NODE(parser, IntrinsicVectorTypeSpec)
+  NODE(parser, VectorElementType)
   NODE(parser, Verbatim)
   NODE(parser, Volatile)
   NODE(parser, VolatileStmt)

flang/include/flang/Parser/parse-tree.h

@@ -708,6 +708,21 @@ struct IntrinsicTypeSpec {
       u;
 };
 
+// Extension: Vector type
+WRAPPER_CLASS(UnsignedTypeSpec, std::optional<KindSelector>);
+struct VectorElementType {
+  UNION_CLASS_BOILERPLATE(VectorElementType);
+  std::variant<IntegerTypeSpec, IntrinsicTypeSpec::Real, UnsignedTypeSpec> u;
+};
+WRAPPER_CLASS(IntrinsicVectorTypeSpec, VectorElementType);
+struct VectorTypeSpec {
+  UNION_CLASS_BOILERPLATE(VectorTypeSpec);
+  EMPTY_CLASS(PairVectorTypeSpec);
+  EMPTY_CLASS(QuadVectorTypeSpec);
+  std::variant<IntrinsicVectorTypeSpec, PairVectorTypeSpec, QuadVectorTypeSpec>
+      u;
+};
+
 // R755 type-param-spec -> [keyword =] type-param-value
 struct TypeParamSpec {
   TUPLE_CLASS_BOILERPLATE(TypeParamSpec);
@@ -748,7 +763,9 @@ struct DeclarationTypeSpec {
   EMPTY_CLASS(ClassStar);
   EMPTY_CLASS(TypeStar);
   WRAPPER_CLASS(Record, Name);
-  std::variant<IntrinsicTypeSpec, Type, Class, ClassStar, TypeStar, Record> u;
+  std::variant<IntrinsicTypeSpec, Type, Class, ClassStar, TypeStar, Record,
+      VectorTypeSpec>
+      u;
 };
 
 // R709 kind-param -> digit-string | scalar-int-constant-name

flang/include/flang/Semantics/semantics.h

@@ -215,7 +215,9 @@ class SemanticsContext {
   void UseFortranBuiltinsModule();
   const Scope *GetBuiltinsScope() const { return builtinsScope_; }
 
+  void UsePPCFortranBuiltinTypesModule();
   void UsePPCFortranBuiltinsModule();
+  Scope *GetPPCBuiltinTypesScope() { return ppcBuiltinTypesScope_; }
   const Scope *GetPPCBuiltinsScope() const { return ppcBuiltinsScope_; }
 
   // Saves a module file's parse tree so that it remains available
@@ -278,6 +280,7 @@ class SemanticsContext {
   UnorderedSymbolSet errorSymbols_;
   std::set<std::string> tempNames_;
   const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
+  Scope *ppcBuiltinTypesScope_{nullptr}; // module __Fortran_PPC_types
   const Scope *ppcBuiltinsScope_{nullptr}; // module __Fortran_PPC_intrinsics
   std::list<parser::Program> modFileParseTrees_;
   std::unique_ptr<CommonBlockMap> commonBlockMap_;

flang/include/flang/Semantics/type.h

@@ -249,6 +249,8 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ArraySpec &);
 // The name may not match the symbol's name in case of a USE rename.
 class DerivedTypeSpec {
 public:
+  enum class Category { DerivedType, IntrinsicVector, PairVector, QuadVector };
+
   using RawParameter = std::pair<const parser::Keyword *, ParamValue>;
   using RawParameters = std::vector<RawParameter>;
   using ParameterMapType = std::map<SourceName, ParamValue>;
@@ -305,6 +307,13 @@ class DerivedTypeSpec {
   bool Match(const DerivedTypeSpec &) const;
   std::string AsFortran() const;
 
+  Category category() const { return category_; }
+  void set_category(Category category) { category_ = category; }
+  bool IsVectorType() const {
+    return category_ == Category::IntrinsicVector ||
+        category_ == Category::PairVector || category_ == Category::QuadVector;
+  }
+
 private:
   SourceName name_;
   const Symbol &typeSymbol_;
@@ -314,6 +323,7 @@ class DerivedTypeSpec {
   bool instantiated_{false};
   RawParameters rawParameters_;
   ParameterMapType parameters_;
+  Category category_{Category::DerivedType};
   bool RawEquals(const DerivedTypeSpec &that) const {
     return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ &&
         rawParameters_ == that.rawParameters_;

flang/lib/Evaluate/type.cpp

@@ -152,8 +152,21 @@ std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
 std::size_t DynamicType::GetAlignment(
     const TargetCharacteristics &targetCharacteristics) const {
   if (category_ == TypeCategory::Derived) {
-    if (derived_ && derived_->scope()) {
-      return derived_->scope()->alignment().value_or(1);
+    switch (GetDerivedTypeSpec().category()) {
+      SWITCH_COVERS_ALL_CASES
+    case semantics::DerivedTypeSpec::Category::DerivedType:
+      if (derived_ && derived_->scope()) {
+        return derived_->scope()->alignment().value_or(1);
+      }
+      break;
+    case semantics::DerivedTypeSpec::Category::IntrinsicVector:
+    case semantics::DerivedTypeSpec::Category::PairVector:
+    case semantics::DerivedTypeSpec::Category::QuadVector:
+      if (derived_ && derived_->scope()) {
+        return derived_->scope()->size();
+      } else {
+        common::die("Missing scope for Vector type.");
+      }
     }
   } else {
     return targetCharacteristics.GetAlignment(category_, kind_);

flang/lib/Lower/Bridge.cpp

@@ -3388,7 +3388,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
               // Scalar assignment
               const bool isNumericScalar =
                   isNumericScalarCategory(lhsType->category());
-              fir::ExtendedValue rhs = isNumericScalar
+              const bool isVector =
+                  isDerivedCategory(lhsType->category()) &&
+                  lhsType->GetDerivedTypeSpec().IsVectorType();
+              fir::ExtendedValue rhs = (isNumericScalar || isVector)
                                            ? genExprValue(assign.rhs, stmtCtx)
                                            : genExprAddr(assign.rhs, stmtCtx);
               const bool lhsIsWholeAllocatable =
@@ -3436,7 +3439,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                 return genExprAddr(assign.lhs, stmtCtx);
               }();
 
-              if (isNumericScalar) {
+              if (isNumericScalar || isVector) {
                 // Fortran 2018 10.2.1.3 p8 and p9
                 // Conversions should have been inserted by semantic analysis,
                 // but they can be incorrect between the rhs and lhs. Correct
@@ -3450,7 +3453,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                 // conversion to the actual type.
                 mlir::Type toTy = genType(assign.lhs);
                 mlir::Value cast =
-                    builder->convertWithSemantics(loc, toTy, val);
+                    isVector ? val
+                             : builder->convertWithSemantics(loc, toTy, val);
                 if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) {
                   assert(isFuncResultDesignator(assign.lhs) && "type mismatch");
                   addr = builder->createConvert(

flang/lib/Lower/CallInterface.cpp

@@ -788,10 +788,12 @@ class Fortran::lower::CallInterfaceImpl {
       }
     } else if (dynamicType.category() ==
                Fortran::common::TypeCategory::Derived) {
-      // Derived result need to be allocated by the caller and the result value
-      // must be saved. Derived type in implicit interface cannot have length
-      // parameters.
-      setSaveResult();
+      if (!dynamicType.GetDerivedTypeSpec().IsVectorType()) {
+        // Derived result need to be allocated by the caller and the result
+        // value must be saved. Derived type in implicit interface cannot have
+        // length parameters.
+        setSaveResult();
+      }
       mlir::Type mlirType = translateDynamicType(dynamicType);
       addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
                    Property::Value);

flang/lib/Lower/ConvertType.cpp

@@ -23,6 +23,8 @@
 
 #define DEBUG_TYPE "flang-lower-type"
 
+using Fortran::common::VectorElementCategory;
+
 //===--------------------------------------------------------------------===//
 // Intrinsic type translation helpers
 //===--------------------------------------------------------------------===//
@@ -53,20 +55,25 @@ int getIntegerBits() {
   return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
                                  KIND>::Scalar::bits;
 }
-static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) {
+static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind,
+                                 bool isUnsigned = false) {
   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
           Fortran::common::TypeCategory::Integer, kind)) {
+    mlir::IntegerType::SignednessSemantics signedness =
+        (isUnsigned ? mlir::IntegerType::SignednessSemantics::Unsigned
+                    : mlir::IntegerType::SignednessSemantics::Signless);
+
     switch (kind) {
     case 1:
-      return mlir::IntegerType::get(context, getIntegerBits<1>());
+      return mlir::IntegerType::get(context, getIntegerBits<1>(), signedness);
     case 2:
-      return mlir::IntegerType::get(context, getIntegerBits<2>());
+      return mlir::IntegerType::get(context, getIntegerBits<2>(), signedness);
     case 4:
-      return mlir::IntegerType::get(context, getIntegerBits<4>());
+      return mlir::IntegerType::get(context, getIntegerBits<4>(), signedness);
     case 8:
-      return mlir::IntegerType::get(context, getIntegerBits<8>());
+      return mlir::IntegerType::get(context, getIntegerBits<8>(), signedness);
     case 16:
-      return mlir::IntegerType::get(context, getIntegerBits<16>());
+      return mlir::IntegerType::get(context, getIntegerBits<16>(), signedness);
     }
   }
   llvm_unreachable("INTEGER kind not translated");
@@ -308,13 +315,67 @@ struct TypeBuilderImpl {
     return false;
   }
 
+  mlir::Type genVectorType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
+    assert(tySpec.scope() && "Missing scope for Vector type");
+    auto vectorSize{tySpec.scope()->size()};
+    switch (tySpec.category()) {
+      SWITCH_COVERS_ALL_CASES
+    case (Fortran::semantics::DerivedTypeSpec::Category::IntrinsicVector): {
+      int64_t vecElemKind;
+      int64_t vecElemCategory;
+
+      for (const auto &pair : tySpec.parameters()) {
+        if (pair.first == "element_category") {
+          vecElemCategory =
+              Fortran::evaluate::ToInt64(pair.second.GetExplicit())
+                  .value_or(-1);
+        } else if (pair.first == "element_kind") {
+          vecElemKind =
+              Fortran::evaluate::ToInt64(pair.second.GetExplicit()).value_or(0);
+        }
+      }
+
+      assert((vecElemCategory >= 0 &&
+              static_cast<size_t>(vecElemCategory) <
+                  Fortran::common::VectorElementCategory_enumSize) &&
+             "Vector element type is not specified");
+      assert(vecElemKind && "Vector element kind is not specified");
+
+      int64_t numOfElements = vectorSize / vecElemKind;
+      switch (static_cast<VectorElementCategory>(vecElemCategory)) {
+        SWITCH_COVERS_ALL_CASES
+      case VectorElementCategory::Integer:
+        return fir::VectorType::get(numOfElements,
+                                    genIntegerType(context, vecElemKind));
+      case VectorElementCategory::Unsigned:
+        return fir::VectorType::get(numOfElements,
+                                    genIntegerType(context, vecElemKind, true));
+      case VectorElementCategory::Real:
+        return fir::VectorType::get(numOfElements,
+                                    genRealType(context, vecElemKind));
+      }
+      break;
+    }
+    case (Fortran::semantics::DerivedTypeSpec::Category::PairVector):
+    case (Fortran::semantics::DerivedTypeSpec::Category::QuadVector):
+      return fir::VectorType::get(vectorSize * 8,
+                                  mlir::IntegerType::get(context, 1));
+    case (Fortran::semantics::DerivedTypeSpec::Category::DerivedType):
+      Fortran::common::die("Vector element type not implemented");
+    }
+  }
+
   mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
     std::vector<std::pair<std::string, mlir::Type>> ps;
     std::vector<std::pair<std::string, mlir::Type>> cs;
     const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol();
     if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol))
       return ty;
 
+    if (tySpec.IsVectorType()) {
+      return genVectorType(tySpec);
+    }
+
     auto rec = fir::RecordType::get(context, converter.mangleName(tySpec));
     // Maintain the stack of types for recursive references.
     derivedTypeInConstruction.emplace_back(typeSymbol, rec);

flang/lib/Parser/Fortran-parsers.cpp

@@ -191,7 +191,8 @@ TYPE_CONTEXT_PARSER("declaration type spec"_en_US,
                 // the structure includes the surrounding slashes to avoid
                 // name clashes.
                 construct<DeclarationTypeSpec::Record>(
-                    "RECORD" >> sourced("/" >> name / "/")))))
+                    "RECORD" >> sourced("/" >> name / "/")))) ||
+        construct<DeclarationTypeSpec>(vectorTypeSpec))
 
 // R704 intrinsic-type-spec ->
 //        integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
@@ -218,6 +219,28 @@ TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
             construct<IntrinsicTypeSpec>(construct<IntegerTypeSpec>(
                 "BYTE" >> construct<std::optional<KindSelector>>(pure(1)))))))
 
+// Extension: Vector type
+// VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD
+TYPE_CONTEXT_PARSER("vector type spec"_en_US,
+    extension<LanguageFeature::PPCVector>(
+        "nonstandard usage: Vector type"_port_en_US,
+        first(construct<VectorTypeSpec>(intrinsicVectorTypeSpec),
+            construct<VectorTypeSpec>("__VECTOR_PAIR" >>
+                construct<VectorTypeSpec::PairVectorTypeSpec>()),
+            construct<VectorTypeSpec>("__VECTOR_QUAD" >>
+                construct<VectorTypeSpec::QuadVectorTypeSpec>()))))
+
+// VECTOR(integer-type-spec) | VECTOR(real-type-spec) |
+// VECTOR(unsigend-type-spec) |
+TYPE_PARSER(construct<IntrinsicVectorTypeSpec>("VECTOR" >>
+    parenthesized(construct<VectorElementType>(integerTypeSpec) ||
+        construct<VectorElementType>(unsignedTypeSpec) ||
+        construct<VectorElementType>(construct<IntrinsicTypeSpec::Real>(
+            "REAL" >> maybe(kindSelector))))))
+
+// UNSIGNED type
+TYPE_PARSER(construct<UnsignedTypeSpec>("UNSIGNED" >> maybe(kindSelector)))
+
 // R705 integer-type-spec -> INTEGER [kind-selector]
 TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector)))
 

flang/lib/Parser/type-parsers.h

@@ -137,5 +137,8 @@ constexpr Parser<OpenACCDeclarativeConstruct> openaccDeclarativeConstruct;
 constexpr Parser<OpenMPConstruct> openmpConstruct;
 constexpr Parser<OpenMPDeclarativeConstruct> openmpDeclarativeConstruct;
 constexpr Parser<OmpEndLoopDirective> ompEndLoopDirective;
+constexpr Parser<IntrinsicVectorTypeSpec> intrinsicVectorTypeSpec; // Extension
+constexpr Parser<VectorTypeSpec> vectorTypeSpec; // Extension
+constexpr Parser<UnsignedTypeSpec> unsignedTypeSpec; // Extension
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_TYPE_PARSERS_H_

flang/lib/Parser/unparse.cpp

@@ -161,6 +161,15 @@ class UnparseVisitor {
   void Post(const IntrinsicTypeSpec::DoubleComplex &) {
     Word("DOUBLE COMPLEX");
   }
+  void Before(const UnsignedTypeSpec &) { Word("UNSIGNED"); }
+  void Before(const IntrinsicVectorTypeSpec &) { Word("VECTOR("); }
+  void Post(const IntrinsicVectorTypeSpec &) { Put(')'); }
+  void Post(const VectorTypeSpec::PairVectorTypeSpec &) {
+    Word("__VECTOR_PAIR");
+  }
+  void Post(const VectorTypeSpec::QuadVectorTypeSpec &) {
+    Word("__VECTOR_QUAD");
+  }
   void Before(const IntegerTypeSpec &) { // R705
     Word("INTEGER");
   }

flang/lib/Semantics/resolve-names-utils.cpp

@@ -614,7 +614,8 @@ bool EquivalenceSets::CheckObject(const parser::Name &name) {
     msg = "Variable '%s' in common block with BIND attribute"
           " is not allowed in an equivalence set"_err_en_US;
   } else if (const auto *type{symbol.GetType()}) {
-    if (const auto *derived{type->AsDerived()}) {
+    const auto *derived{type->AsDerived()};
+    if (derived && !derived->IsVectorType()) {
       if (const auto *comp{FindUltimateComponent(
               *derived, IsAllocatableOrPointer)}) { // C8106
         msg = IsPointer(*comp)