- thread default kinds to code gen

schweitzpgi · schweitzpgi · commit 9fc509523458 · 2020-09-14T13:49:02.000-07:00
- fix some bugs
- some work on furthering support of descriptors for "F77" I/O
diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h
@@ -21,6 +21,9 @@
 namespace fir {
 struct NameUniquer;
 }
+namespace llvm {
+class Triple;
+}
 
 namespace Fortran {
 namespace common {
@@ -52,8 +55,11 @@ class LoweringBridge {
   create(mlir::MLIRContext &ctx,
          const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
          const Fortran::evaluate::IntrinsicProcTable &intrinsics,
-         const Fortran::parser::AllCookedSources &allCooked) {
-    return LoweringBridge{defaultKinds, intrinsics, allCooked};
+         const Fortran::parser::AllCookedSource &allCooked,
+         llvm::Triple &triple, fir::NameUniquer &uniquer,
+         fir::KindMapping &kindMap) {
+    return LoweringBridge(ctx, defaultKinds, intrinsics, allCooked, triple,
+                          uniquer, kindMap);
   }
 
   //===--------------------------------------------------------------------===//
@@ -89,15 +95,16 @@ class LoweringBridge {
   void parseSourceFile(llvm::SourceMgr &);
 
   /// Cross the bridge from the Fortran parse-tree, etc. to MLIR dialects
-  void lower(const Fortran::parser::Program &program, fir::NameUniquer &uniquer,
+  void lower(const Fortran::parser::Program &program,
              const Fortran::semantics::SemanticsContext &semanticsContext);
 
 private:
   explicit LoweringBridge(
       mlir::MLIRContext &ctx,
       const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
       const Fortran::evaluate::IntrinsicProcTable &intrinsics,
-      const Fortran::parser::AllCookedSources &);
+      const Fortran::parser::AllCookedSource &cooked, llvm::Triple &triple,
+      fir::NameUniquer &uniquer, fir::KindMapping &kindMap);
   LoweringBridge() = delete;
   LoweringBridge(const LoweringBridge &) = delete;
 
@@ -106,7 +113,7 @@ class LoweringBridge {
   const Fortran::parser::AllCookedSources *cooked;
   std::unique_ptr<mlir::MLIRContext> context;
   std::unique_ptr<mlir::ModuleOp> module;
-  fir::KindMapping kindMap;
+  fir::KindMapping &kindMap;
 };
 
 } // namespace lower
diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h
@@ -5,6 +5,10 @@
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_CHARACTEREXPR_H
 #define FORTRAN_LOWER_CHARACTEREXPR_H
@@ -107,7 +111,10 @@ class CharacterExprHelper {
   static bool isCharacter(mlir::Type type);
 
   /// Extract the kind of a character type
-  static int getCharacterKind(mlir::Type type);
+  static fir::KindTy getCharacterKind(mlir::Type type);
+
+  /// Extract the kind of a character or array of character type.
+  static fir::KindTy getCharacterOrSequenceKind(mlir::Type type);
 
   /// Determine the base character type
   static fir::CharacterType getCharacterType(mlir::Type type);
@@ -130,6 +137,14 @@ class CharacterExprHelper {
   fir::ExtendedValue toExtendedValue(mlir::Value character,
                                      mlir::Value len = {});
 
+  /// Is `type` a sequence (array) of CHARACTER type? Return true for any of the
+  /// following cases:
+  ///   - !fir.array<len x dim x ... x !fir.char<kind>>
+  ///   - !fir.array<dim x !fir.char<kind, len>>
+  ///   - !fir.ref<T>  where T is either of the first two cases
+  ///   - !fir.box<T>  where T is either of the first two cases
+  static bool isArray(mlir::Type type);
+
 private:
   fir::CharBoxValue materializeValue(const fir::CharBoxValue &str);
   fir::CharBoxValue toDataLengthPair(mlir::Value character);
diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -36,7 +36,7 @@ namespace fir {
 
 class FIROpsDialect;
 
-using KindTy = int;
+using KindTy = unsigned;
 
 namespace detail {
 struct BoxTypeStorage;
diff --git a/flang/include/flang/Optimizer/Support/KindMapping.h b/flang/include/flang/Optimizer/Support/KindMapping.h
@@ -5,6 +5,10 @@
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #ifndef OPTIMIZER_SUPPORT_KINDMAPPING_H
 #define OPTIMIZER_SUPPORT_KINDMAPPING_H
@@ -48,8 +52,10 @@ class KindMapping {
   using LLVMTypeID = llvm::Type::TypeID;
   using MatchResult = mlir::ParseResult;
 
-  explicit KindMapping(mlir::MLIRContext *context);
-  explicit KindMapping(mlir::MLIRContext *context, llvm::StringRef map);
+  explicit KindMapping(mlir::MLIRContext *context,
+                       llvm::ArrayRef<KindTy> defs = llvm::None);
+  explicit KindMapping(mlir::MLIRContext *context, llvm::StringRef map,
+                       llvm::ArrayRef<KindTy> defs = llvm::None);
 
   /// Get the size in bits of !fir.char<kind>
   Bitsize getCharacterBitsize(KindTy kind) const;
@@ -74,13 +80,26 @@ class KindMapping {
   /// Get the float semantics of !fir.real<kind>
   const llvm::fltSemantics &getFloatSemantics(KindTy kind) const;
 
+  //===--------------------------------------------------------------------===//
+  // Default kinds of intrinsic types
+  //===--------------------------------------------------------------------===//
+
+  KindTy defaultCharacterKind() const;
+  KindTy defaultComplexKind() const;
+  KindTy defaultDoubleKind() const;
+  KindTy defaultIntegerKind() const;
+  KindTy defaultLogicalKind() const;
+  KindTy defaultRealKind() const;
+
 private:
   MatchResult badMapString(const llvm::Twine &ptr);
   MatchResult parse(llvm::StringRef kindMap);
+  mlir::LogicalResult setDefaultKinds(llvm::ArrayRef<KindTy> defs);
 
   mlir::MLIRContext *context;
   llvm::DenseMap<std::pair<char, KindTy>, Bitsize> intMap;
   llvm::DenseMap<std::pair<char, KindTy>, LLVMTypeID> floatMap;
+  llvm::DenseMap<char, KindTy> defaultMap;
 };
 
 } // namespace fir
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
@@ -29,6 +29,7 @@
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Support/FIRContext.h"
 #include "flang/Optimizer/Support/InternalNames.h"
 #include "flang/Optimizer/Transforms/Passes.h"
 #include "flang/Parser/parse-tree.h"
@@ -41,6 +42,7 @@
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/ErrorHandling.h"
 #include "llvm/Support/MD5.h"
+
 #define DEBUG_TYPE "flang-lower-bridge"
 
 #undef TODO
@@ -2435,12 +2437,12 @@ Fortran::lower::LoweringBridge::createFoldingContext() const {
 }
 
 void Fortran::lower::LoweringBridge::lower(
-    const Fortran::parser::Program &prg, fir::NameUniquer &uniquer,
+    const Fortran::parser::Program &prg,
     const Fortran::semantics::SemanticsContext &semanticsContext) {
   auto pft = Fortran::lower::createPFT(prg, semanticsContext);
   if (dumpBeforeFir)
     Fortran::lower::dumpPFT(llvm::errs(), *pft);
-  FirConverter converter{*this, uniquer};
+  FirConverter converter{*this, *fir::getNameUniquer(getModule())};
   converter.run(*pft);
 }
 
@@ -2451,12 +2453,14 @@ void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) {
 }
 
 Fortran::lower::LoweringBridge::LoweringBridge(
-    mlir::MLIRContext &ctx,
+    mlir::MLIRContext &context,
     const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
     const Fortran::evaluate::IntrinsicProcTable &intrinsics,
-    const Fortran::parser::CookedSource &cooked)
-    : defaultKinds{defaultKinds},
-      intrinsics{intrinsics}, cooked{&cooked}, context{ctx}, kindMap{&ctx} {
+    const Fortran::parser::CookedSource &cooked, llvm::Triple &triple,
+    fir::NameUniquer &uniquer, fir::KindMapping &kindMap)
+    : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked},
+      context{context}, kindMap{kindMap} {
+  // Register the diagnostic handler.
   context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) {
     auto &os = llvm::errs();
     switch (diag.getSeverity()) {
@@ -2478,6 +2482,12 @@ Fortran::lower::LoweringBridge::LoweringBridge(
     os.flush();
     return mlir::success();
   });
+
+  // Create the module and attach the attributes.
   module = std::make_unique<mlir::ModuleOp>(
       mlir::ModuleOp::create(mlir::UnknownLoc::get(&context)));
+  assert(module.get() && "module was not created");
+  fir::setTargetTriple(*module.get(), triple);
+  fir::setNameUniquer(*module.get(), uniquer);
+  fir::setKindMapping(*module.get(), kindMap);
 }
diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp
@@ -5,6 +5,10 @@
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #include "flang/Lower/CharacterExpr.h"
 #include "flang/Lower/ConvertType.h"
@@ -17,22 +21,30 @@
 // CharacterExprHelper implementation
 //===----------------------------------------------------------------------===//
 
-/// Get fir.char<kind> type with the same kind as inside str.
-fir::CharacterType
-Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Type type) {
+template <bool checkForScalar>
+static fir::CharacterType recoverCharacterType(mlir::Type type) {
   if (auto boxType = type.dyn_cast<fir::BoxCharType>())
     return boxType.getEleTy();
   if (auto refType = type.dyn_cast<fir::ReferenceType>())
     type = refType.getEleTy();
   if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
-    assert(seqType.getShape().size() == 1 && "rank must be 1");
+    // In a context where `type` may be a sequence, we want to opt out of this
+    // assertion by setting `checkForScalar` to `false`.
+    assert((!checkForScalar || seqType.getShape().size() == 1) &&
+           "rank must be 1 for a scalar CHARACTER");
     type = seqType.getEleTy();
   }
   if (auto charType = type.dyn_cast<fir::CharacterType>())
     return charType;
   llvm_unreachable("Invalid character value type");
 }
 
+/// Get fir.char<kind> type with the same kind as inside str.
+fir::CharacterType
+Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Type type) {
+  return recoverCharacterType<true>(type);
+}
+
 fir::CharacterType Fortran::lower::CharacterExprHelper::getCharacterType(
     const fir::CharBoxValue &box) {
   return getCharacterType(box.getBuffer().getType());
@@ -528,6 +540,25 @@ bool Fortran::lower::CharacterExprHelper::isCharacter(mlir::Type type) {
   return type.isa<fir::CharacterType>();
 }
 
-int Fortran::lower::CharacterExprHelper::getCharacterKind(mlir::Type type) {
-  return getCharacterType(type).getFKind();
+fir::KindTy
+Fortran::lower::CharacterExprHelper::getCharacterKind(mlir::Type type) {
+  return recoverCharacterType<true>(type).getFKind();
+}
+
+fir::KindTy Fortran::lower::CharacterExprHelper::getCharacterOrSequenceKind(
+    mlir::Type type) {
+  return recoverCharacterType<false>(type).getFKind();
+}
+
+bool Fortran::lower::CharacterExprHelper::isArray(mlir::Type type) {
+  if (auto boxTy = type.dyn_cast<fir::BoxType>())
+    type = boxTy.getEleTy();
+  if (auto eleTy = fir::dyn_cast_ptrEleTy(type))
+    type = eleTy;
+  if (auto seqTy = type.dyn_cast<fir::SequenceType>()) {
+    auto charTy = seqTy.getEleTy().dyn_cast<fir::CharacterType>();
+    assert(charTy);
+    return (!charTy.singleton()) || (seqTy.getDimension() > 1);
+  }
+  return false;
 }
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
diff --git a/flang/lib/Optimizer/Support/KindMapping.cpp b/flang/lib/Optimizer/Support/KindMapping.cpp
diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp
