Support for PowerPC vector type - derived type based representation

[tislam]

Summary

This revision is a followup to Support for PowerPC vector type. The current solution internally represents PowerPC vector types as derived-types. A new builtin module, named __fortran_ppc_types has been added to declare the corresponding derived-types.

The idea of using derived-types was suggested by Jean Perier and Peter Klausler.

Contributors:
Coauthor: Daniel Chen (IBM)
Co-designers: Daniel Chen (IBM), Kelvin Li (IBM)

For convenience, the summary from the original review is added below.

This RFC is for adding the PowerPC vector type support as a language extension.

It has the following syntax:

VECTOR(element-type-spec)

where

element-type-spec

is:

integer-type-spec

or

real-type-spec

or

unsigned-type-spec

A finite set of functionalities are implemented in order to support the PowerPC vector type:

1. declare VECTOR type objects.
2. declare VECTOR type function result.
3. declare VECTOR type dummy arguments.
4. intrinsic assignment between VECTOR type objects. (e.g. v1 = v2)
5. reference VECTOR functions.

This patch only supports the functionalities mentioned at the above. Others, such as intrinsic operators are not extended to support vectors as all operations on vector types (such as addition, subtraction, construction, ... etc) are done via calls to vector intrinsic functions. The support of constant expressions, derived component, POINTER or ALLOCATABLE attribute, I/O, and etc is not included in this patch.

The purpose of this RFC is to get comments from the community on our implementation approach. We plan to add the LIT tests in this patch as a revision soon. We also plan to add semantic checking in a separate patch in the near future.

[klausler]

This is an excellent patch, and I have no comments apart from some easily-fixed minor concerns.

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

39

Can you please use a more specific name, like PPCVector? Thanks

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

715–717

You don't need the explicit constructors here. UNION_CLASS_BOILERPLATE supplies a template constructor for you.

flang/include/flang/Semantics/type.h

252

Consider using the more modern enum class feature here instead of a plain enum. It enables the C++ build compiler to check for missing cases in switch statements.

flang/lib/Evaluate/type.cpp

168

common::die() or DIE() is better for crashes that aren't really about unreachable code.

flang/lib/Parser/Fortran-parsers.cpp

175

Please make this new alternative the last one, not the first, so that compilations of code without PPC vector types are not slowed down by this change.

228

The _sptok suffixes here are probably not what you want.

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

618

Is the extra test needed here? What happens if it's not present?

flang/lib/Semantics/resolve-names.cpp

1086

Trailing underscore on the private component name, please.

4667

Will programs using non-constant kind expressions cause a crash here? You might want to change the result type to std::optional<int> and be more error-recoverable.

[tschuett]

flang/lib/Lower/ConvertType.cpp

364

error message or die. The place is reachable.

flang/lib/Semantics/resolve-names.cpp

4667

error message or die. optional might be confusing.

[tislam]

Addressed the following review comments:

• flang/include/flang/Common/Fortran-features.h: Changed enum name from Vector to PPCVector.
• flang/include/flang/Parser/parse-tree.h: Removed explicit constructors for VectorElementType.
• flang/include/flang/Semantics/type.h: Changed enum to ENUM_CLASS for Category inside DerivedTypeSpec.
• Replaced llvm_unreachable with common::die.
• Updated parsing rules.
• flang/lib/Semantics/resolve-names.cpp: Renamed isVectorType to isVectorType_.
• Added flang/module/__fortran_ppc_types.f90. This file was missing in the first version.

[tislam]

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

618

Without the test, Flang does not allow entities of vector type in equivalence.

flang/lib/Semantics/resolve-names.cpp

4667

Using common::die here.

[tschuett]

flang/include/flang/Semantics/type.h

252

enum class Category {DerivedType, IntrinsicVector, PairVector, QuadVector};

Is enum class insufficient or because of style?

[tschuett]

Do you want to add an unparse test?
There are no tests?

Is the usage limited to PowerPC?

[tislam]

Changes in this revision:

• flang/include/flang/Semantics/type.h: Changed ENUM_CLASS to enum class for Category in DerivedTypeSpec.
• Added a new test (flang/test/Semantics/ppc-vector-types.f90) to verify unparsing.
• Added a new test (flang/test/Lower/ppc-vector-types.f90) to verify lowering.

[tislam]

In D150876#4355343, @tschuett wrote:

Do you want to add an unparse test?
There are no tests?

Thanks @tschuett.
I have added two tests to verify the unparsing and lowering of vector types.

Is the usage limited to PowerPC?

That is correct. The current patch is targetted for PowerPC.

[tislam]

flang/include/flang/Semantics/type.h

252

I have changed this to enum class.

[tschuett]

Where do you check that it is only available on PowerPC?

[tschuett]

flang/lib/Semantics/semantics.cpp

511–512

I found it!

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

ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     ClassicCComments, AdditionalFormats, BigIntLiterals, RealDoControls,
     EquivalenceNumericWithCharacter, EquivalenceNonDefaultNumeric,
     EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents,
     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
     ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
     ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
     SaveMainProgram, SaveBigMainProgramVariables,
-    DistinctArrayConstructorLengths)
+    DistinctArrayConstructorLengths, Vector)
 
 // Portability and suspicious usage warnings for conforming code
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     NonTargetPassedToTarget, PointerToPossibleNoncontiguous,
     ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,
     PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;

flang/include/flang/Common/Fortran.h

 #include "idioms.h"
 #include <cinttypes>
 #include <string>
 
 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 ||
       category == TypeCategory::Complex;
 }
 
 // Kinds of IMPORT statements. Default means IMPORT or IMPORT :: names.
 ENUM_CLASS(ImportKind, Default, Only, None, All)

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

#include "llvm/Frontend/OpenMP/OMP.inc"
   NODE(parser, TypeParamSpec)
   NODE(parser, TypeParamValue)
   NODE(TypeParamValue, Deferred)
   NODE(parser, TypeSpec)
   NODE(parser, Union)
   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)
   NODE(parser, WaitSpec)
   NODE(parser, WaitStmt)
   NODE(parser, WhereBodyConstruct)
   NODE(parser, WhereConstruct)
   NODE(WhereConstruct, Elsewhere)

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

struct Logical {
     std::optional<KindSelector> kind;
   };
   EMPTY_CLASS(DoubleComplex);
   std::variant<IntegerTypeSpec, Real, DoublePrecision, Complex, Character,
       Logical, DoubleComplex>
       u;
 };
 
+// Extension: Vector type
+WRAPPER_CLASS(UnsignedTypeSpec, std::optional<KindSelector>);
+struct VectorElementType {
+  UNION_CLASS_BOILERPLATE(VectorElementType);
+  VectorElementType(IntegerTypeSpec &&its) : u(std::move(its)) {}
+  VectorElementType(IntrinsicTypeSpec::Real &&r) : u(std::move(r)) {}
+  VectorElementType(UnsignedTypeSpec &&us) : u(std::move(us)) {}
+  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);
   std::tuple<std::optional<Keyword>, TypeParamValue> t;
 };
 
 // R754 derived-type-spec -> type-name [(type-param-spec-list)]
 struct DerivedTypeSpec {
struct DeclarationTypeSpec {
   struct Class {
     BOILERPLATE(Class);
     Class(DerivedTypeSpec &&dt) : derived(std::move(dt)) {}
     DerivedTypeSpec derived;
   };
   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
 struct KindParam {
   UNION_CLASS_BOILERPLATE(KindParam);
   std::variant<std::uint64_t, Scalar<Integer<Constant<Name>>>> u;
 };
 

flang/include/flang/Semantics/semantics.h

public:
 
   // Locate and process the contents of a built-in module on demand
   Scope *GetBuiltinModule(const char *name);
 
   // Defines builtinsScope_ from the __Fortran_builtins module
   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
   // during semantics.
   parser::Program &SaveParseTree(parser::Program &&);
 
   // Ensures a common block definition does not conflict with previous
   // appearances in the program and consolidate information about
struct IndexVarInfo {
     parser::CharBlock location;
     IndexVarKind kind;
   };
   std::map<SymbolRef, const IndexVarInfo, SymbolAddressCompare>
       activeIndexVars_;
   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_;
   bool anyDefinedIntrinsicOperator_{false};
 };
 
 class Semantics {
 public:

flang/include/flang/Semantics/type.h

private:
   }
 };
 llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ArraySpec &);
 
 // Each DerivedTypeSpec has a typeSymbol that has DerivedTypeDetails.
 // The name may not match the symbol's name in case of a USE rename.
 class DerivedTypeSpec {
 public:
+  enum Category { DerivedType, IntrinsicVector, PairVector, QuadVector };
+
   using RawParameter = std::pair<const parser::Keyword *, ParamValue>;
   using RawParameters = std::vector<RawParameter>;
   using ParameterMapType = std::map<SourceName, ParamValue>;
   DerivedTypeSpec(SourceName, const Symbol &);
   DerivedTypeSpec(const DerivedTypeSpec &);
   DerivedTypeSpec(DerivedTypeSpec &&);
 
   const SourceName &name() const { return name_; }
public:
   bool operator!=(const DerivedTypeSpec &that) const {
     return !(*this == that);
   }
   // For TYPE IS & CLASS IS: kind type parameters must be
   // explicit and equal, len type parameters are ignored.
   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_ == IntrinsicVector || category_ == PairVector ||
+        category_ == QuadVector;
+  }
+
 private:
   SourceName name_;
   const Symbol &typeSymbol_;
   const Scope *scope_{nullptr}; // same as typeSymbol_.scope() unless PDT
   bool cooked_{false};
   bool evaluated_{false};
   bool instantiated_{false};
   RawParameters rawParameters_;
   ParameterMapType parameters_;
+  Category category_{DerivedType};
   bool RawEquals(const DerivedTypeSpec &that) const {
     return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ &&
         rawParameters_ == that.rawParameters_;
   }
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const DerivedTypeSpec &);
 };
 

flang/lib/Evaluate/type.cpp

if (category_ == TypeCategory::Character) {
     }
   }
   return std::nullopt;
 }
 
 std::size_t DynamicType::GetAlignment(
     const TargetCharacteristics &targetCharacteristics) const {
   if (category_ == TypeCategory::Derived) {
+    switch (GetDerivedTypeSpec().category()) {
+      SWITCH_COVERS_ALL_CASES
+    case semantics::DerivedTypeSpec::DerivedType:
       if (derived_ && derived_->scope()) {
         return derived_->scope()->alignment().value_or(1);
       }
+      break;
+    case semantics::DerivedTypeSpec::IntrinsicVector:
+    case semantics::DerivedTypeSpec::PairVector:
+    case semantics::DerivedTypeSpec::QuadVector:
+      if (derived_ && derived_->scope()) {
+        return derived_->scope()->size();
+      } else {
+        llvm_unreachable("Missing scope for Vector type.");
+      }
+    }
   } else {
     return targetCharacteristics.GetAlignment(category_, kind_);
   }
   return 1; // needs to be after switch to dodge a bogus gcc warning
 }
 
 std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
     FoldingContext &context, bool aligned,

flang/lib/Lower/Bridge.cpp

std::visit(
                 // See Fortran 2018 10.2.1.3 p5, p6, and p7
                 genArrayAssignment(assign, stmtCtx);
                 return;
               }
 
               // 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 =
                   Fortran::lower::isWholeAllocatable(assign.lhs);
               std::optional<fir::factory::MutableBoxReallocation> lhsRealloc;
               std::optional<fir::MutableBoxValue> lhsMutableBox;
 
               // Set flag to know if the LHS needs finalization. Polymorphic,
std::visit(
                   lhsRealloc = fir::factory::genReallocIfNeeded(
                       *builder, loc, *lhsMutableBox,
                       /*shape=*/std::nullopt, lengthParams);
                   return lhsRealloc->newValue;
                 }
                 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
                 // that here.
                 mlir::Value addr = fir::getBase(lhs);
                 mlir::Value val = fir::getBase(rhs);
                 // A function with multiple entry points returning different
                 // types tags all result variables with one of the largest
                 // types to allow them to share the same storage. Assignment
                 // to a result variable of one of the other types requires
                 // 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(
                       toLocation(), builder->getRefType(toTy), addr);
                 }
                 builder->create<fir::StoreOp>(loc, cast, addr);
               } else if (isCharacterCategory(lhsType->category())) {
                 // Fortran 2018 10.2.1.3 p10 and p11

flang/lib/Lower/CallInterface.cpp

if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
         mlir::Type mlirType = translateDynamicType(dynamicType);
         addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
                      Property::Value);
       } else {
         handleImplicitCharacterResult(dynamicType);
       }
     } 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.
+      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);
     } else {
       // All result other than characters/derived are simply returned by value
       // in implicit interfaces
       mlir::Type mlirType =
           getConverter().genType(dynamicType.category(), dynamicType.kind());

flang/lib/Lower/ConvertType.cpp

 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-type"
 
+using Fortran::common::VectorElementCategory;
+
 //===--------------------------------------------------------------------===//
 // Intrinsic type translation helpers
 //===--------------------------------------------------------------------===//
 
 static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
           Fortran::common::TypeCategory::Real, kind)) {
     switch (kind) {
static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
   llvm_unreachable("REAL type translation not implemented");
 }
 
 template <int KIND>
 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");
 }
 
 static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
           Fortran::common::TypeCategory::Logical, KIND))
if (const auto *objDetails =
       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
         if (auto lb = bounds.lbound().GetExplicit())
           if (auto constant = Fortran::evaluate::ToInt64(*lb))
             if (!constant || *constant != 1)
               return true;
     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::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::PairVector):
+    case (Fortran::semantics::DerivedTypeSpec::QuadVector):
+      return fir::VectorType::get(vectorSize * 8,
+                                  mlir::IntegerType::get(context, 1));
+    case (Fortran::semantics::DerivedTypeSpec::DerivedType):
+      llvm_unreachable("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);
 
     // Gather the record type fields.
     // (1) The data components.
     for (const auto &field :
          Fortran::semantics::OrderedComponentIterator(tySpec)) {

flang/lib/Parser/Fortran-parsers.cpp

 // N.B. It is critical to distribute "parenthesized()" over the alternatives
 // for TYPE (...), rather than putting the alternatives within it, which
 // would fail on "TYPE(real_derived)" with a misrecognition of "real" as an
 // intrinsic-type-spec.
 // N.B. TYPE(x) is a derived type if x is a one-word extension intrinsic
 // type (BYTE or DOUBLECOMPLEX), not the extension intrinsic type.
 TYPE_CONTEXT_PARSER("declaration type spec"_en_US,
     construct<DeclarationTypeSpec>(intrinsicTypeSpec) ||
+        construct<DeclarationTypeSpec>(vectorTypeSpec) ||
         "TYPE" >>
             (parenthesized(construct<DeclarationTypeSpec>(
                  !"DOUBLECOMPLEX"_tok >> !"BYTE"_tok >> intrinsicTypeSpec)) ||
                 parenthesized(construct<DeclarationTypeSpec>(
                     construct<DeclarationTypeSpec::Type>(derivedTypeSpec))) ||
                 construct<DeclarationTypeSpec>(
                     "( * )" >> construct<DeclarationTypeSpec::TypeStar>())) ||
         "CLASS" >> parenthesized(construct<DeclarationTypeSpec>(
first(construct<IntrinsicTypeSpec>(integerTypeSpec),
         extension<LanguageFeature::DoubleComplex>(
             "nonstandard usage: DOUBLE COMPLEX"_port_en_US,
             construct<IntrinsicTypeSpec>("DOUBLE COMPLEX"_sptok >>
                 construct<IntrinsicTypeSpec::DoubleComplex>())),
         extension<LanguageFeature::Byte>("nonstandard usage: BYTE"_port_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::Vector>(
+        "nonstandard usage: Vector type"_port_en_US,
+        first(construct<VectorTypeSpec>(intrinsicVectorTypeSpec),
+            construct<VectorTypeSpec>("__VECTOR_PAIR"_sptok >>
+                construct<VectorTypeSpec::PairVectorTypeSpec>()),
+            construct<VectorTypeSpec>("__VECTOR_QUAD"_sptok >>
+                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)))
 
 // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr )
 // Legacy extension: kind-selector -> * digit-string
 TYPE_PARSER(construct<KindSelector>(
                 parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||
     extension<LanguageFeature::StarKind>(

flang/lib/Parser/type-parsers.h

 constexpr Parser<ContainsStmt> containsStmt; // R1543
 constexpr Parser<CompilerDirective> compilerDirective;
 constexpr Parser<OpenACCConstruct> openaccConstruct;
 constexpr Parser<AccEndCombinedDirective> accEndCombinedDirective;
 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

public:
   void Post(const IntrinsicTypeSpec::DoublePrecision &) {
     Word("DOUBLE PRECISION");
   }
   void Before(const IntrinsicTypeSpec::Character &) { Word("CHARACTER"); }
   void Before(const IntrinsicTypeSpec::Logical &) { Word("LOGICAL"); }
   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");
   }
   void Unparse(const KindSelector &x) { // R706
     common::visit(
         common::visitors{
             [&](const ScalarIntConstantExpr &y) {
               Put('('), Word("KIND="), Walk(y), Put(')');

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

if (symbol.owner().IsDerivedType()) { // C8107
     msg = "Variable '%s' with TARGET attribute"
           " is not allowed in an equivalence set"_err_en_US;
   } else if (IsNamedConstant(symbol)) { // C8106
     msg = "Named constant '%s' is not allowed in an equivalence set"_err_en_US;
   } else if (InCommonWithBind(symbol)) { // C8106
     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)
             ? "Derived type object '%s' with pointer ultimate component"
               " is not allowed in an equivalence set"_err_en_US
             : "Derived type object '%s' with allocatable ultimate component"
               " is not allowed in an equivalence set"_err_en_US;
       } else if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) {

flang/lib/Semantics/resolve-names.cpp

public:
   void Post(const parser::IntrinsicTypeSpec::Real &);
   void Post(const parser::IntrinsicTypeSpec::Complex &);
   void Post(const parser::IntrinsicTypeSpec::Logical &);
   void Post(const parser::IntrinsicTypeSpec::Character &);
   void Post(const parser::CharSelector::LengthAndKind &);
   void Post(const parser::CharLength &);
   void Post(const parser::LengthSelector &);
   bool Pre(const parser::KindParam &);
+  bool Pre(const parser::VectorTypeSpec &);
+  void Post(const parser::VectorTypeSpec &);
   bool Pre(const parser::DeclarationTypeSpec::Type &);
   void Post(const parser::DeclarationTypeSpec::Type &);
   bool Pre(const parser::DeclarationTypeSpec::Class &);
   void Post(const parser::DeclarationTypeSpec::Class &);
   void Post(const parser::DeclarationTypeSpec::Record &);
   void Post(const parser::DerivedTypeSpec &);
   bool Pre(const parser::DerivedTypeDef &);
   bool Pre(const parser::DerivedTypeStmt &);
public:
   void PointerInitialization(
       const parser::Name &, const parser::ProcPointerInit &);
   void NonPointerInitialization(
       const parser::Name &, const parser::ConstantExpr &);
   void CheckExplicitInterface(const parser::Name &);
   void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
 
   const parser::Name *ResolveDesignator(const parser::Designator &);
+  int GetVectorElementKind(
+      TypeCategory category, const std::optional<parser::KindSelector> &kind);
 
 protected:
   bool BeginDecl();
   void EndDecl();
   Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
   // Make sure that there's an entity in an enclosing scope called Name
   Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
   // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
struct EnumeratorState {
     std::optional<int> value{0};
   } enumerationState_;
   // Set for OldParameterStmt processing
   bool inOldStyleParameterStmt_{false};
   // Set when walking DATA & array constructor implied DO loop bounds
   // to warn about use of the implied DO intex therein.
   std::optional<SourceName> checkIndexUseInOwnBounds_;
   bool hasBindCName_{false};
+  bool isVectorType{false};
 
   bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
   Symbol &HandleAttributeStmt(Attr, const parser::Name &);
   Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);
   Symbol &DeclareProcEntity(
       const parser::Name &, Attrs, const Symbol *interface);
   void SetType(const parser::Name &, const DeclTypeSpec &);
   std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
Symbol &DeclarationVisitor::DeclareObjectEntity(
   }
   ClearArraySpec();
   ClearCoarraySpec();
   charInfo_.length.reset();
   return symbol;
 }
 
 void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
+  if (!isVectorType) {
     SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
   }
+}
 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
+  if (!isVectorType) {
     SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
   }
+}
 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {
   SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind));
 }
 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {
   SetDeclTypeSpec(MakeLogicalType(x.kind));
 }
 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
   if (!charInfo_.length) {
if (const auto *kind{std::get_if<
     const parser::Name &name{kind->thing.thing.thing};
     if (!FindSymbol(name)) {
       Say(name, "Parameter '%s' not found"_err_en_US);
     }
   }
   return false;
 }
 
+int DeclarationVisitor::GetVectorElementKind(
+    TypeCategory category, const std::optional<parser::KindSelector> &kind) {
+  KindExpr value{GetKindParamExpr(category, kind)};
+  if (auto known{evaluate::ToInt64(value)}) {
+    return static_cast<int>(*known);
+  }
+  llvm_unreachable("Vector element kind must be known at compile-time");
+}
+
+bool DeclarationVisitor::Pre(const parser::VectorTypeSpec &) {
+  isVectorType = true;
+  return true;
+}
+// Create semantic::DerivedTypeSpec for Vector types here.
+void DeclarationVisitor::Post(const parser::VectorTypeSpec &x) {
+  llvm::StringRef typeName;
+  llvm::SmallVector<ParamValue> typeParams;
+  DerivedTypeSpec::Category vectorCategory;
+
+  isVectorType = false;
+  common::visit(
+      common::visitors{
+          [&](const parser::IntrinsicVectorTypeSpec &y) {
+            vectorCategory = DerivedTypeSpec::Category::IntrinsicVector;
+            int vecElemKind = 0;
+            typeName = "__builtin_ppc_intrinsic_vector";
+            common::visit(
+                common::visitors{
+                    [&](const parser::IntegerTypeSpec &z) {
+                      vecElemKind = GetVectorElementKind(
+                          TypeCategory::Integer, std::move(z.v));
+                      typeParams.push_back(ParamValue(
+                          static_cast<common::ConstantSubscript>(
+                              common::VectorElementCategory::Integer),
+                          common::TypeParamAttr::Kind));
+                    },
+                    [&](const parser::IntrinsicTypeSpec::Real &z) {
+                      vecElemKind = GetVectorElementKind(
+                          TypeCategory::Real, std::move(z.kind));
+                      typeParams.push_back(
+                          ParamValue(static_cast<common::ConstantSubscript>(
+                                         common::VectorElementCategory::Real),
+                              common::TypeParamAttr::Kind));
+                    },
+                    [&](const parser::UnsignedTypeSpec &z) {
+                      vecElemKind = GetVectorElementKind(
+                          TypeCategory::Integer, std::move(z.v));
+                      typeParams.push_back(ParamValue(
+                          static_cast<common::ConstantSubscript>(
+                              common::VectorElementCategory::Unsigned),
+                          common::TypeParamAttr::Kind));
+                    },
+                },
+                y.v.u);
+            typeParams.push_back(
+                ParamValue(static_cast<common::ConstantSubscript>(vecElemKind),
+                    common::TypeParamAttr::Kind));
+          },
+          [&](const parser::VectorTypeSpec::PairVectorTypeSpec &y) {
+            vectorCategory = DerivedTypeSpec::Category::PairVector;
+            typeName = "__builtin_ppc_pair_vector";
+          },
+          [&](const parser::VectorTypeSpec::QuadVectorTypeSpec &y) {
+            vectorCategory = DerivedTypeSpec::Category::QuadVector;
+            typeName = "__builtin_ppc_quad_vector";
+          },
+      },
+      x.u);
+
+  auto ppcBuiltinTypesScope = currScope().context().GetPPCBuiltinTypesScope();
+  if (!ppcBuiltinTypesScope) {
+    common::die("INTERNAL: The __fortran_ppc_types module was not found ");
+  }
+
+  auto iter{ppcBuiltinTypesScope->find(
+      semantics::SourceName{typeName.data(), typeName.size()})};
+  if (iter == ppcBuiltinTypesScope->cend()) {
+    common::die("INTERNAL: The __fortran_ppc_types module does not define "
+                "the type '%s'",
+        typeName.data());
+  }
+
+  const semantics::Symbol &typeSymbol{*iter->second};
+  DerivedTypeSpec vectorDerivedType{typeName.data(), typeSymbol};
+  vectorDerivedType.set_category(vectorCategory);
+  if (typeParams.size()) {
+    vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[0]));
+    vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[1]));
+    vectorDerivedType.CookParameters(GetFoldingContext());
+  }
+
+  if (const DeclTypeSpec *
+      extant{ppcBuiltinTypesScope->FindInstantiatedDerivedType(
+          vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) {
+    // This derived type and parameter expressions (if any) are already present
+    // in the __fortran_ppc_intrinsics scope.
+    SetDeclTypeSpec(*extant);
+  } else {
+    DeclTypeSpec &type{ppcBuiltinTypesScope->MakeDerivedType(
+        DeclTypeSpec::Category::TypeDerived, std::move(vectorDerivedType))};
+    DerivedTypeSpec &derived{type.derivedTypeSpec()};
+    auto restorer{
+        GetFoldingContext().messages().SetLocation(currStmtSource().value())};
+    derived.Instantiate(*ppcBuiltinTypesScope);
+    SetDeclTypeSpec(type);
+  }
+}
+
 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
   CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);
   return true;
 }
 
 void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) {
   const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)};
   if (const Symbol * derivedSymbol{derivedName.symbol}) {

flang/lib/Semantics/semantics.cpp

void SemanticsContext::UseFortranBuiltinsModule() {
   if (builtinsScope_ == nullptr) {
     builtinsScope_ = GetBuiltinModule("__fortran_builtins");
     if (builtinsScope_) {
       intrinsics_.SupplyBuiltins(*builtinsScope_);
     }
   }
 }
 
+void SemanticsContext::UsePPCFortranBuiltinTypesModule() {
+  if (ppcBuiltinTypesScope_ == nullptr) {
+    ppcBuiltinTypesScope_ = GetBuiltinModule("__fortran_ppc_types");
+  }
+}
+
 void SemanticsContext::UsePPCFortranBuiltinsModule() {
   if (ppcBuiltinsScope_ == nullptr) {
     ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics");
   }
 }
 
 parser::Program &SemanticsContext::SaveParseTree(parser::Program &&tree) {
   return modFileParseTrees_.emplace_back(std::move(tree));
 }
 
 bool Semantics::Perform() {
   // Implicitly USE the __Fortran_builtins module so that special types
   // (e.g., __builtin_team_type) are available to semantics, esp. for
   // intrinsic checking.
   if (!program_.v.empty()) {
     const auto *frontModule{std::get_if<common::Indirection<parser::Module>>(
         &program_.v.front().u)};
     if (frontModule &&
         (std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t)
                     .statement.v.source == "__fortran_builtins" ||
             std::get<parser::Statement<parser::ModuleStmt>>(
                 frontModule->value().t)
-                    .statement.v.source == "__fortran_ppc_intrinsics")) {
+                    .statement.v.source == "__fortran_ppc_intrinsics" ||
+            std::get<parser::Statement<parser::ModuleStmt>>(
+                frontModule->value().t)
+                    .statement.v.source == "__fortran_ppc_types")) {
       // Don't try to read the builtins module when we're actually building it.
     } else {
       context_.UseFortranBuiltinsModule();
       llvm::Triple targetTriple{llvm::Triple(
           llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))};
       // Only use __Fortran_PPC_intrinsics module when targetting PowerPC arch
       if (targetTriple.isPPC()) {
+        context_.UsePPCFortranBuiltinTypesModule();
         context_.UsePPCFortranBuiltinsModule();
       }
     }
   }
   return ValidateLabels(context_, program_) &&
       parser::CanonicalizeDo(program_) && // force line break
       CanonicalizeAcc(context_.messages(), program_) &&
       CanonicalizeOmp(context_.messages(), program_) &&

flang/tools/f18/CMakeLists.txt

 set(LLVM_LINK_COMPONENTS
   FrontendOpenACC
   FrontendOpenMP
   Support
   )
 
 set(MODULES
   "__fortran_builtins"
   "__fortran_ieee_exceptions"
   "__fortran_type_info"
+  "__fortran_ppc_types"
   "__fortran_ppc_intrinsics"
   "ieee_arithmetic"
   "ieee_exceptions"
   "ieee_features"
   "iso_c_binding"
   "iso_fortran_env"
   "omp_lib"
   "__fortran_builtins"
   "__fortran_type_info"
 )
 
 # Create module files directly from the top-level module source directory.
 # If CMAKE_CROSSCOMPILING, then the newly built flang-new executable was
 # cross compiled, and thus can't be executed on the build system and thus
 # can't be used for generating module files.
 if (NOT CMAKE_CROSSCOMPILING)
   foreach(filename ${MODULES})
     set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename})
     if(${filename} STREQUAL "__fortran_builtins")
       set(depends "")
-    elseif(${filename} STREQUAL "__fortran_ppc_intrinsics")
+    elseif(${filename} STREQUAL "__fortran_ppc_types")
       set(depends "")
+    elseif(${filename} STREQUAL "__fortran_ppc_intrinsics")
+      set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ppc_types.mod)
     else()
       set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_builtins.mod)
       if(NOT ${filename} STREQUAL "__fortran_type_info")
         set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod)
       endif()
       if(${filename} STREQUAL "ieee_arithmetic" OR
          ${filename} STREQUAL "ieee_exceptions")
         set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ieee_exceptions.mod)