[flang] Initial lowering for empty program

[clementval]

Summary

This patch enable lowering from Fortran to FIR for a basic empty
program. It brings all the infrastructure needed for that. As discussed
previously, this is the first patch for lowering and follow up patches
should be smaller.

With this patch we can lower the following code:

program basic
end program

To a the FIR equivalent:

func @_QQmain() {
  return
}

Follow up patch will add lowering of more complex constructs.

[rovka]

Yaay, it's great to see this patch! :)
I think it's a bit large though, maybe we can remove some things that aren't strictly necessary to make the test pass? That would make both this patch and future patches (where things are actually useed) easier to review.

flang/include/flang/Lower/CallInterface.h

81

82

116

Nit: missing ).
Also, I can't really guess what this comment means since I haven't read the whole patch yet and have no idea what all these names refer to. Maybe it would be a good idea to clarify the expected usage of FirPlaceHolder?

120

Why do we need this? Wouldn't this be obvious from the type? (Maybe add it when it's actually used, then hopefully it will be obvious?)

137

Are these actually written in this patch? Or just read? Can we introduce them later?

flang/lib/Lower/Bridge.cpp

40

I'm seeing a lot of final overrides, is the whole class intended to be final by any chance? If so, we should just mark it as such upfront.

151

Might crash and burn if builder isn't instantiated yet.

189

Nit: Should we also assert that localSymbols is empty?

194

Nit: Changing the visibility doesn't seem to be related to the builder, so maybe move it up right after the creation of func? And then you can probably remove the changes to the insertion point from this patch and upstream them when they're actually relevant.

250

Nit: Is this actually used?

251

Where is this used? I see some references to it, but it doesn't seem to be populated (or I could be just missing it, it's Friday). Maybe we can upstream the SymMap in a future patch, to make this easier to review?

[clementval]

In D118436#3278753, @rovka wrote:

Yaay, it's great to see this patch! :)
I think it's a bit large though, maybe we can remove some things that aren't strictly necessary to make the test pass? That would make both this patch and future patches (where things are actually useed) easier to review.

It was discussed multiple time that the initial patch would be larger. We tried to trim it down and probably it could be a little bit smaller. As mentioned in the description, follow up patches will be smaller.

flang/lib/Lower/Bridge.cpp

251

SymMap was mostly present in the lowering directory. This patch moves it and makes some updates.

[rovka]

Ok, I went over the dead code too and I don't see anything obviously wrong with it. I guess we can come back to it as more cases get supported in future patches.
LGTM with the nits addressed. You should probably wait for someone else to have a look too, since I'm not very familiar with lowering.

flang/lib/Lower/CallInterface.cpp

64

[clementval]

Address couple of typos and nits comments

[clementval]

flang/lib/Lower/CallInterface.cpp

64

Good catch

[kiranchandramohan]

@clementval can you rebase or remove the parent so that the patch application will succeed?

[clementval]

In D118436#3279312, @kiranchandramohan wrote:

@clementval can you rebase or remove the parent so that the patch application will succeed?

I removed the parent but looks like it's not enough. I'll rebase.

[clementval]

Rebase

[kiranchandramohan]

Thanks @clementval for the patch. The patch looks nice and well carved out.

I have the following suggestions. You can decide what from the following list to apply.

1. I think the SymbolMap.h movement looks like an NFC and unrelated to this patch. Can you submit that directly without a review?
2. I think from SymbolMap.cpp only lookupSymbol is used and other additions can be removed.
3. I would recommend removing FirPlaceHolder from this patch since that deals with input and output of functions/subroutines and not related to an empty program. genFunctionType can be replaced with the following and - llvm::SmallVector<FirPlaceHolder> outputs;, llvm::SmallVector<FirPlaceHolder> inputs; removed.

template <typename T>
mlir::FunctionType Fortran::lower::CallInterface<T>::genFunctionType() {
 return mlir::FunctionType::get(&converter.getMLIRContext(), {}, {});
}

The declare function can be stripped of

for (const auto &placeHolder : llvm::enumerate(inputs))
        if (!placeHolder.value().attributes.empty())
          func.setArgAttrs(placeHolder.index(), placeHolder.value().attributes);

4. I think bbc.cpp includes a lot of headers that are probably not needed at the moment like unparse-with-symbols.h, SCFToStandard.h,GreedyPatternRewriteDriver.h,TargetSelect.h. Similarly for the libraries as well.

[PeteSteinfeld]

I've built and tested both in-tree and out-of-tree builds, and all builds and tests without error.

After building, I tried running flang-new on a minimal program, and I got the following message:

error: code-generation is not available yet

@awarzynski , do we need to do something to enable running flang-new to create an executable now?

[clementval]

In D118436#3280354, @PeteSteinfeld wrote:

I've built and tested both in-tree and out-of-tree builds, and all builds and tests without error.

After building, I tried running flang-new on a minimal program, and I got the following message:

error: code-generation is not available yet

@awarzynski , do we need to do something to enable running flang-new to create an executable now?

The flang-new driver will need some parts to be upstream as well in order to be able to lower code. This is not part of this patch.

[clementval]

Remove some code

[awarzynski]

In D118436#3280512, @clementval wrote:

The flang-new driver will need some parts to be upstream as well in order to be able to lower code. This is not part of this patch.

Do you mean "lowering" code per-se, or driver code? I've only skimmed this patch through and it seems that I could start upstreaming the driver itself (i.e. being able to lower an empty program should be sufficient). I might be missing something though. @clementval ?

[clementval]

In D118436#3283473, @awarzynski wrote:

In D118436#3280512, @clementval wrote:

The flang-new driver will need some parts to be upstream as well in order to be able to lower code. This is not part of this patch.

Do you mean "lowering" code per-se, or driver code? I've only skimmed this patch through and it seems that I could start upstreaming the driver itself (i.e. being able to lower an empty program should be sufficient). I might be missing something though. @clementval ?

Just driver code I guess. I was just pointing that this patch does not enable lowering in the driver itself but just with bbc.

flang/include/flang/Lower/AbstractConverter.h

 //===-- Lower/AbstractConverter.h -------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_ABSTRACTCONVERTER_H
 #define FORTRAN_LOWER_ABSTRACTCONVERTER_H
 
 #include "flang/Common/Fortran.h"
+#include "flang/Optimizer/Builder/BoxValue.h"
 #include "mlir/IR/BuiltinOps.h"
+#include "llvm/ADT/ArrayRef.h"
+
+namespace fir {
+class KindMapping;
+class FirOpBuilder;
+} // namespace fir
 
 namespace fir {
 class KindMapping;
 class FirOpBuilder;
 } // namespace fir
 
 namespace Fortran {
 namespace common {
 template <typename>
 class Reference;
 }
+
 namespace evaluate {
 struct DataRef;
 template <typename>
 class Expr;
 class FoldingContext;
 struct SomeType;
 } // namespace evaluate
 
 namespace parser {
 class CharBlock;
 }
 namespace semantics {
 class Symbol;
-}
+class DerivedTypeSpec;
+} // namespace semantics
 
 namespace lower {
 namespace pft {
 struct Variable;
 }
 
 using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
 using SymbolRef = Fortran::common::Reference<const Fortran::semantics::Symbol>;
public:
 
   //===--------------------------------------------------------------------===//
   // Locations
   //===--------------------------------------------------------------------===//
 
   /// Get the converter's current location
   virtual mlir::Location getCurrentLocation() = 0;
   /// Generate a dummy location
-  virtual mlir::Location genLocation() = 0;
+  virtual mlir::Location genUnknownLocation() = 0;
   /// Generate the location as converted from a CharBlock
   virtual mlir::Location genLocation(const Fortran::parser::CharBlock &) = 0;
 
   //===--------------------------------------------------------------------===//
   // FIR/MLIR
   //===--------------------------------------------------------------------===//
 
   /// Get the OpBuilder
   virtual fir::FirOpBuilder &getFirOpBuilder() = 0;
   /// Get the ModuleOp
   virtual mlir::ModuleOp &getModuleOp() = 0;
   /// Get the MLIRContext
   virtual mlir::MLIRContext &getMLIRContext() = 0;
   /// Unique a symbol
   virtual std::string mangleName(const Fortran::semantics::Symbol &) = 0;
-  /// Unique a compiler generated identifier. A short prefix should be provided
-  /// to hint at the origin of the identifier.
-  virtual std::string uniqueCGIdent(llvm::StringRef prefix,
-                                    llvm::StringRef name) = 0;
+  /// Get the KindMap.
+  virtual const fir::KindMapping &getKindMap() = 0;
 
   virtual ~AbstractConverter() = default;
 };
 
 } // namespace lower
 } // namespace Fortran
 
 #endif // FORTRAN_LOWER_ABSTRACTCONVERTER_H

flang/include/flang/Lower/Bridge.h

 //===----------------------------------------------------------------------===//
 
 /// The lowering bridge converts the front-end parse trees and semantics
 /// checking residual to MLIR (FIR dialect) code.
 class LoweringBridge {
 public:
   /// Create a lowering bridge instance.
   static LoweringBridge
-  create(const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
+  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::AllCookedSources &allCooked,
+         llvm::StringRef triple, fir::KindMapping &kindMap) {
+    return LoweringBridge(ctx, defaultKinds, intrinsics, allCooked, triple,
+                          kindMap);
   }
 
   //===--------------------------------------------------------------------===//
   // Getters
   //===--------------------------------------------------------------------===//
 
-  mlir::MLIRContext &getMLIRContext() { return *context.get(); }
+  mlir::MLIRContext &getMLIRContext() { return context; }
   mlir::ModuleOp &getModule() { return *module.get(); }
   const Fortran::common::IntrinsicTypeDefaultKinds &getDefaultKinds() const {
     return defaultKinds;
   }
   const Fortran::evaluate::IntrinsicProcTable &getIntrinsicTable() const {
     return intrinsics;
   }
   const Fortran::parser::AllCookedSources *getCookedSource() const {
public:
   void parseSourceFile(llvm::SourceMgr &);
 
   /// Cross the bridge from the Fortran parse-tree, etc. to MLIR dialects
   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::AllCookedSources &cooked, llvm::StringRef triple,
+      fir::KindMapping &kindMap);
   LoweringBridge() = delete;
   LoweringBridge(const LoweringBridge &) = delete;
 
   const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds;
   const Fortran::evaluate::IntrinsicProcTable &intrinsics;
   const Fortran::parser::AllCookedSources *cooked;
-  std::unique_ptr<mlir::MLIRContext> context;
+  mlir::MLIRContext &context;
   std::unique_ptr<mlir::ModuleOp> module;
-  fir::KindMapping kindMap;
+  fir::KindMapping &kindMap;
 };
 
 } // namespace lower
 } // namespace Fortran
 
 #endif // FORTRAN_LOWER_BRIDGE_H

flang/include/flang/Lower/CallInterface.h

+//===-- Lower/CallInterface.h -- Procedure call interface ------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+//
+// Utility that defines fir call interface for procedure both on caller and
+// and callee side and get the related FuncOp.
+// It does not emit any FIR code but for the created mlir::FuncOp, instead it
+// provides back a container of Symbol (callee side)/ActualArgument (caller
+// side) with additional information for each element describing how it must be
+// plugged with the mlir::FuncOp.
+// It handles the fact that hidden arguments may be inserted for the result.
+// while lowering.
+//
+// This utility uses the characteristic of Fortran procedures to operate, which
+// is a term and concept used in Fortran to refer to the signature of a function
+// or subroutine.
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_CALLINTERFACE_H
+#define FORTRAN_LOWER_CALLINTERFACE_H
+
+#include "flang/Common/reference.h"
+#include "flang/Evaluate/characteristics.h"
+#include "mlir/IR/BuiltinOps.h"
+#include <memory>
+#include <optional>
+
+namespace Fortran::semantics {
+class Symbol;
+}
+
+namespace mlir {
+class Location;
+}
+
+namespace Fortran::lower {
+class AbstractConverter;
+namespace pft {
+struct FunctionLikeUnit;
+}
+
+/// PassedEntityTypes helps abstract whether CallInterface is mapping a
+/// Symbol to mlir::Value (callee side) or an ActualArgument to a position
+/// inside the input vector for the CallOp (caller side. It will be up to the
+/// CallInterface user to produce the mlir::Value that will go in this input
+/// vector).
+class CalleeInterface;
+template <typename T>
+struct PassedEntityTypes {};
+template <>
+struct PassedEntityTypes<CalleeInterface> {
+  using FortranEntity =
+      std::optional<common::Reference<const semantics::Symbol>>;
+  using FirValue = mlir::Value;
+};
+
+/// Implementation helper
+template <typename T>
+class CallInterfaceImpl;
+
+/// CallInterface defines all the logic to determine FIR function interfaces
+/// from a characteristic, build the mlir::FuncOp and describe back the argument
+/// mapping to its user.
+/// The logic is shared between the callee and caller sides that it accepts as
+/// a curiously recursive template to handle the few things that cannot be
+/// shared between both sides (getting characteristics, mangled name, location).
+/// It maps FIR arguments to front-end Symbol (callee side) or ActualArgument
+/// (caller side) with the same code using the abstract FortranEntity type that
+/// can be either a Symbol or an ActualArgument.
+/// It works in two passes: a first pass over the characteristics that decides
+/// how the interface must be. Then, the funcOp is created for it. Then a simple
+/// pass over fir arguments finalizes the interface information that must be
+/// passed back to the user (and may require having the funcOp). All these
+/// passes are driven from the CallInterface constructor.
+template <typename T>
+class CallInterface {
+  friend CallInterfaceImpl<T>;
+
+public:
+  /// Different properties of an entity that can be passed/returned.
+  /// One-to-One mapping with PassEntityBy but for
+  /// PassEntityBy::AddressAndLength that has two properties.
+  enum class Property {
+    BaseAddress,
+    BoxChar,
+    CharAddress,
+    CharLength,
+    CharProcTuple,
+    Box,
+    MutableBox,
+    Value
+  };
+
+  using FortranEntity = typename PassedEntityTypes<T>::FortranEntity;
+  using FirValue = typename PassedEntityTypes<T>::FirValue;
+
+  /// Returns the mlir function type
+  mlir::FunctionType genFunctionType();
+
+protected:
+  CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {}
+  /// CRTP handle.
+  T &side() { return *static_cast<T *>(this); }
+  /// Entry point to be called by child ctor to analyze the signature and
+  /// create/find the mlir::FuncOp. Child needs to be initialized first.
+  void declare();
+
+  mlir::FuncOp func;
+
+  Fortran::lower::AbstractConverter &converter;
+};
+
+//===----------------------------------------------------------------------===//
+// Callee side interface
+//===----------------------------------------------------------------------===//
+
+/// CalleeInterface only provides the helpers needed by CallInterface
+/// to abstract the specificities of the callee side.
+class CalleeInterface : public CallInterface<CalleeInterface> {
+public:
+  CalleeInterface(Fortran::lower::pft::FunctionLikeUnit &f,
+                  Fortran::lower::AbstractConverter &c)
+      : CallInterface{c}, funit{f} {
+    declare();
+  }
+
+  std::string getMangledName() const;
+  mlir::Location getCalleeLocation() const;
+  Fortran::evaluate::characteristics::Procedure characterize() const;
+
+  /// On the callee side it does not matter whether the procedure is
+  /// called through pointers or not.
+  bool isIndirectCall() const { return false; }
+
+  /// Return the procedure symbol if this is a call to a user defined
+  /// procedure.
+  const Fortran::semantics::Symbol *getProcedureSymbol() const;
+
+  /// Add mlir::FuncOp entry block and map fir block arguments to Fortran dummy
+  /// argument symbols.
+  mlir::FuncOp addEntryBlockAndMapArguments();
+
+private:
+  Fortran::lower::pft::FunctionLikeUnit &funit;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_FIRBUILDER_H

flang/include/flang/Lower/PFTBuilder.h

struct ProgramUnit : ProgramVariant {
   ProgramUnit(const A &p, const PftNode &parent)
       : ProgramVariant{p}, parent{parent} {}
   ProgramUnit(ProgramUnit &&) = default;
   ProgramUnit(const ProgramUnit &) = delete;
 
   PftNode parent;
 };
 
+/// Helper to get location from FunctionLikeUnit/ModuleLikeUnit begin/end
+/// statements.
+template <typename T>
+static parser::CharBlock stmtSourceLoc(const T &stmt) {
+  return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
+}
+
 /// A variable captures an object to be created per the declaration part of a
 /// function like unit.
 ///
 /// Fortran EQUIVALENCE statements are a mechanism that introduces aliasing
 /// between named variables. The set of overlapping aliases will materialize a
 /// generic store object with a designated offset and size. Participant
 /// symbols will simply be pointers into the aggregate store.
 ///

flang/include/flang/Lower/Support/Verifier.h

+//===-- Lower/Support/Verifier.h -- verify pass for lowering ----*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_SUPPORT_VERIFIER_H
+#define FORTRAN_LOWER_SUPPORT_VERIFIER_H
+
+#include "mlir/IR/Verifier.h"
+#include "mlir/Pass/Pass.h"
+
+namespace Fortran::lower {
+
+/// A verification pass to verify the output from the bridge. This provides a
+/// little bit of glue to run a verifier pass directly.
+class VerifierPass
+    : public mlir::PassWrapper<VerifierPass, mlir::OperationPass<>> {
+  void runOnOperation() override final {
+    if (mlir::failed(mlir::verify(getOperation())))
+      signalPassFailure();
+    markAllAnalysesPreserved();
+  }
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_SUPPORT_VERIFIER_H

flang/include/flang/Lower/SymbolMap.h

+//===-- SymbolMap.h -- lowering internal symbol map -------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_SYMBOLMAP_H
+#define FORTRAN_LOWER_SYMBOLMAP_H
+
+#include "flang/Common/reference.h"
+#include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/Support/Matcher.h"
+#include "flang/Semantics/symbol.h"
+#include "mlir/IR/Value.h"
+#include "llvm/ADT/ArrayRef.h"
+#include "llvm/ADT/DenseMap.h"
+#include "llvm/ADT/Optional.h"
+#include "llvm/ADT/SmallVector.h"
+#include "llvm/Support/Compiler.h"
+
+namespace Fortran::lower {
+
+struct SymbolBox;
+class SymMap;
+llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const SymbolBox &symMap);
+llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const SymMap &symMap);
+
+//===----------------------------------------------------------------------===//
+// Symbol information
+//===----------------------------------------------------------------------===//
+
+/// A dictionary entry of ssa-values that together compose a variable referenced
+/// by a Symbol. For example, the declaration
+///
+///   CHARACTER(LEN=i) :: c(j1,j2)
+///
+/// is a single variable `c`. This variable is a two-dimensional array of
+/// CHARACTER. It has a starting address and three dynamic properties: the LEN
+/// parameter `i` a runtime value describing the length of the CHARACTER, and
+/// the `j1` and `j2` runtime values, which describe the shape of the array.
+///
+/// The lowering bridge needs to be able to record all four of these ssa-values
+/// in the lookup table to be able to correctly lower Fortran to FIR.
+struct SymbolBox : public fir::details::matcher<SymbolBox> {
+  // For lookups that fail, have a monostate
+  using None = std::monostate;
+
+  // Trivial intrinsic type
+  using Intrinsic = fir::AbstractBox;
+
+  // Array variable that uses bounds notation
+  using FullDim = fir::ArrayBoxValue;
+
+  // CHARACTER type variable with its dependent type LEN parameter
+  using Char = fir::CharBoxValue;
+
+  // CHARACTER array variable using bounds notation
+  using CharFullDim = fir::CharArrayBoxValue;
+
+  // Pointer or allocatable variable
+  using PointerOrAllocatable = fir::MutableBoxValue;
+
+  // Non pointer/allocatable variable that must be tracked with
+  // a fir.box (either because it is not contiguous, or assumed rank, or assumed
+  // type, or polymorphic, or because the fir.box is describing an optional
+  // value and cannot be read into one of the other category when lowering the
+  // symbol).
+  using Box = fir::BoxValue;
+
+  using VT = std::variant<Intrinsic, FullDim, Char, CharFullDim,
+                          PointerOrAllocatable, Box, None>;
+
+  //===--------------------------------------------------------------------===//
+  // Constructors
+  //===--------------------------------------------------------------------===//
+
+  SymbolBox() : box{None{}} {}
+  template <typename A>
+  SymbolBox(const A &x) : box{x} {}
+
+  explicit operator bool() const { return !std::holds_alternative<None>(box); }
+
+  fir::ExtendedValue toExtendedValue() const {
+    return match(
+        [](const Fortran::lower::SymbolBox::Intrinsic &box)
+            -> fir::ExtendedValue { return box.getAddr(); },
+        [](const Fortran::lower::SymbolBox::None &) -> fir::ExtendedValue {
+          llvm::report_fatal_error("symbol not mapped");
+        },
+        [](const auto &box) -> fir::ExtendedValue { return box; });
+  }
+
+  //===--------------------------------------------------------------------===//
+  // Accessors
+  //===--------------------------------------------------------------------===//
+
+  /// Get address of the boxed value. For a scalar, this is the address of the
+  /// scalar. For an array, this is the address of the first element in the
+  /// array, etc.
+  mlir::Value getAddr() const {
+    return match([](const None &) { return mlir::Value{}; },
+                 [](const auto &x) { return x.getAddr(); });
+  }
+
+  /// Does the boxed value have an intrinsic type?
+  bool isIntrinsic() const {
+    return match([](const Intrinsic &) { return true; },
+                 [](const Char &) { return true; },
+                 [](const PointerOrAllocatable &x) {
+                   return !x.isDerived() && !x.isUnlimitedPolymorphic();
+                 },
+                 [](const Box &x) {
+                   return !x.isDerived() && !x.isUnlimitedPolymorphic();
+                 },
+                 [](const auto &x) { return false; });
+  }
+
+  /// Does the boxed value have a rank greater than zero?
+  bool hasRank() const {
+    return match([](const Intrinsic &) { return false; },
+                 [](const Char &) { return false; },
+                 [](const None &) { return false; },
+                 [](const PointerOrAllocatable &x) { return x.hasRank(); },
+                 [](const Box &x) { return x.hasRank(); },
+                 [](const auto &x) { return x.getExtents().size() > 0; });
+  }
+
+  /// Does the boxed value have trivial lower bounds (== 1)?
+  bool hasSimpleLBounds() const {
+    return match(
+        [](const FullDim &arr) { return arr.getLBounds().empty(); },
+        [](const CharFullDim &arr) { return arr.getLBounds().empty(); },
+        [](const Box &arr) { return arr.getLBounds().empty(); },
+        [](const auto &) { return false; });
+  }
+
+  /// Does the boxed value have a constant shape?
+  bool hasConstantShape() const {
+    if (auto eleTy = fir::dyn_cast_ptrEleTy(getAddr().getType()))
+      if (auto arrTy = eleTy.dyn_cast<fir::SequenceType>())
+        return arrTy.hasConstantShape();
+    return false;
+  }
+
+  /// Get the lbound if the box explicitly contains it.
+  mlir::Value getLBound(unsigned dim) const {
+    return match([&](const FullDim &box) { return box.getLBounds()[dim]; },
+                 [&](const CharFullDim &box) { return box.getLBounds()[dim]; },
+                 [&](const Box &box) { return box.getLBounds()[dim]; },
+                 [](const auto &) { return mlir::Value{}; });
+  }
+
+  /// Apply the lambda `func` to this box value.
+  template <typename ON, typename RT>
+  constexpr RT apply(RT(&&func)(const ON &)) const {
+    if (auto *x = std::get_if<ON>(&box))
+      return func(*x);
+    return RT{};
+  }
+
+  const VT &matchee() const { return box; }
+
+  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &os,
+                                       const SymbolBox &symBox);
+
+  /// Dump the map. For debugging.
+  LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; }
+
+private:
+  VT box;
+};
+
+//===----------------------------------------------------------------------===//
+// Map of symbol information
+//===----------------------------------------------------------------------===//
+
+/// Helper class to map front-end symbols to their MLIR representation. This
+/// provides a way to lookup the ssa-values that comprise a Fortran symbol's
+/// runtime attributes. These attributes include its address, its dynamic size,
+/// dynamic bounds information for non-scalar entities, dynamic type parameters,
+/// etc.
+class SymMap {
+public:
+  using AcDoVar = llvm::StringRef;
+
+  SymMap() { pushScope(); }
+  SymMap(const SymMap &) = delete;
+
+  void pushScope() { symbolMapStack.emplace_back(); }
+  void popScope() {
+    symbolMapStack.pop_back();
+    assert(symbolMapStack.size() >= 1);
+  }
+
+  /// Add an extended value to the symbol table.
+  void addSymbol(semantics::SymbolRef sym, const fir::ExtendedValue &ext,
+                 bool force = false);
+
+  /// Add a trivial symbol mapping to an address.
+  void addSymbol(semantics::SymbolRef sym, mlir::Value value,
+                 bool force = false) {
+    makeSym(sym, SymbolBox::Intrinsic(value), force);
+  }
+
+  /// Add a scalar CHARACTER mapping to an (address, len).
+  void addCharSymbol(semantics::SymbolRef sym, mlir::Value value,
+                     mlir::Value len, bool force = false) {
+    makeSym(sym, SymbolBox::Char(value, len), force);
+  }
+  void addCharSymbol(semantics::SymbolRef sym, const SymbolBox::Char &value,
+                     bool force = false) {
+    makeSym(sym, value, force);
+  }
+
+  /// Add an array mapping with (address, shape).
+  void addSymbolWithShape(semantics::SymbolRef sym, mlir::Value value,
+                          llvm::ArrayRef<mlir::Value> shape,
+                          bool force = false) {
+    makeSym(sym, SymbolBox::FullDim(value, shape), force);
+  }
+  void addSymbolWithShape(semantics::SymbolRef sym,
+                          const SymbolBox::FullDim &value, bool force = false) {
+    makeSym(sym, value, force);
+  }
+
+  /// Add an array of CHARACTER mapping.
+  void addCharSymbolWithShape(semantics::SymbolRef sym, mlir::Value value,
+                              mlir::Value len,
+                              llvm::ArrayRef<mlir::Value> shape,
+                              bool force = false) {
+    makeSym(sym, SymbolBox::CharFullDim(value, len, shape), force);
+  }
+  void addCharSymbolWithShape(semantics::SymbolRef sym,
+                              const SymbolBox::CharFullDim &value,
+                              bool force = false) {
+    makeSym(sym, value, force);
+  }
+
+  /// Add an array mapping with bounds notation.
+  void addSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value,
+                           llvm::ArrayRef<mlir::Value> extents,
+                           llvm::ArrayRef<mlir::Value> lbounds,
+                           bool force = false) {
+    makeSym(sym, SymbolBox::FullDim(value, extents, lbounds), force);
+  }
+  void addSymbolWithBounds(semantics::SymbolRef sym,
+                           const SymbolBox::FullDim &value,
+                           bool force = false) {
+    makeSym(sym, value, force);
+  }
+
+  /// Add an array of CHARACTER with bounds notation.
+  void addCharSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value,
+                               mlir::Value len,
+                               llvm::ArrayRef<mlir::Value> extents,
+                               llvm::ArrayRef<mlir::Value> lbounds,
+                               bool force = false) {
+    makeSym(sym, SymbolBox::CharFullDim(value, len, extents, lbounds), force);
+  }
+  void addCharSymbolWithBounds(semantics::SymbolRef sym,
+                               const SymbolBox::CharFullDim &value,
+                               bool force = false) {
+    makeSym(sym, value, force);
+  }
+
+  void addAllocatableOrPointer(semantics::SymbolRef sym,
+                               fir::MutableBoxValue box, bool force = false) {
+    makeSym(sym, box, force);
+  }
+
+  void addBoxSymbol(semantics::SymbolRef sym, mlir::Value irBox,
+                    llvm::ArrayRef<mlir::Value> lbounds,
+                    llvm::ArrayRef<mlir::Value> explicitParams,
+                    llvm::ArrayRef<mlir::Value> explicitExtents,
+                    bool force = false) {
+    makeSym(sym,
+            SymbolBox::Box(irBox, lbounds, explicitParams, explicitExtents),
+            force);
+  }
+  void addBoxSymbol(semantics::SymbolRef sym, const SymbolBox::Box &value,
+                    bool force = false) {
+    makeSym(sym, value, force);
+  }
+
+  /// Find `symbol` and return its value if it appears in the current mappings.
+  SymbolBox lookupSymbol(semantics::SymbolRef sym);
+  SymbolBox lookupSymbol(const semantics::Symbol *sym) {
+    return lookupSymbol(*sym);
+  }
+
+  /// Add a new binding from the ac-do-variable `var` to `value`.
+  void pushImpliedDoBinding(AcDoVar var, mlir::Value value) {
+    impliedDoStack.emplace_back(var, value);
+  }
+
+  /// Pop the most recent implied do binding off the stack.
+  void popImpliedDoBinding() {
+    assert(!impliedDoStack.empty());
+    impliedDoStack.pop_back();
+  }
+
+  /// Lookup the ac-do-variable and return the Value it is bound to.
+  /// If the variable is not found, returns a null Value.
+  mlir::Value lookupImpliedDo(AcDoVar var);
+
+  /// Remove all symbols from the map.
+  void clear() {
+    symbolMapStack.clear();
+    symbolMapStack.emplace_back();
+    assert(symbolMapStack.size() == 1);
+    impliedDoStack.clear();
+  }
+
+  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &os,
+                                       const SymMap &symMap);
+
+  /// Dump the map. For debugging.
+  LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; }
+
+private:
+  /// Add `symbol` to the current map and bind a `box`.
+  void makeSym(semantics::SymbolRef sym, const SymbolBox &box,
+               bool force = false) {
+    if (force)
+      symbolMapStack.back().erase(&*sym);
+    assert(box && "cannot add an undefined symbol box");
+    symbolMapStack.back().try_emplace(&*sym, box);
+  }
+
+  llvm::SmallVector<llvm::DenseMap<const semantics::Symbol *, SymbolBox>>
+      symbolMapStack;
+
+  // Implied DO induction variables are not represented as Se::Symbol in
+  // Ev::Expr. Keep the variable markers in their own stack.
+  llvm::SmallVector<std::pair<AcDoVar, mlir::Value>> impliedDoStack;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_SYMBOLMAP_H

flang/include/flang/Optimizer/Dialect/FIROpsSupport.h

 static constexpr llvm::StringRef getTargetAttrName() { return "fir.target"; }
 
 /// Attribute to mark that a function argument is a character dummy procedure.
 /// Character dummy procedure have special ABI constraints.
 static constexpr llvm::StringRef getCharacterProcedureDummyAttrName() {
   return "fir.char_proc";
 }
 
+/// Attribute to keep track of Fortran scoping information for a symbol.
+static constexpr llvm::StringRef getSymbolAttrName() { return "fir.sym_name"; }
+
 /// Tell if \p value is:
 ///   - a function argument that has attribute \p attributeName
 ///   - or, the result of fir.alloca/fir.allocamem op that has attribute \p
 ///     attributeName
 ///   - or, the result of a fir.address_of of a fir.global that has attribute \p
 ///     attributeName
 ///   - or, a fir.box loaded from a fir.ref<fir.box> that matches one of the
 ///     previous cases.
 bool valueHasFirAttribute(mlir::Value value, llvm::StringRef attributeName);
 
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_DIALECT_FIROPSSUPPORT_H

flang/include/flang/Optimizer/Support/Utils.h

 //===-- Optimizer/Support/Utils.h -------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_OPTIMIZER_SUPPORT_UTILS_H
 #define FORTRAN_OPTIMIZER_SUPPORT_UTILS_H
 
+#include "flang/Common/default-kinds.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
 #include "mlir/Dialect/StandardOps/IR/Ops.h"
 #include "mlir/IR/BuiltinAttributes.h"
 
 namespace fir {
 /// Return the integer value of a arith::ConstantOp.
 inline std::int64_t toInt(mlir::arith::ConstantOp cop) {
   return cop.getValue().cast<mlir::IntegerAttr>().getValue().getSExtValue();
 }
+
+// Translate front-end KINDs for use in the IR and code gen.
+inline std::vector<fir::KindTy>
+fromDefaultKinds(const Fortran::common::IntrinsicTypeDefaultKinds &defKinds) {
+  return {static_cast<fir::KindTy>(defKinds.GetDefaultKind(
+              Fortran::common::TypeCategory::Character)),
+          static_cast<fir::KindTy>(
+              defKinds.GetDefaultKind(Fortran::common::TypeCategory::Complex)),
+          static_cast<fir::KindTy>(defKinds.doublePrecisionKind()),
+          static_cast<fir::KindTy>(
+              defKinds.GetDefaultKind(Fortran::common::TypeCategory::Integer)),
+          static_cast<fir::KindTy>(
+              defKinds.GetDefaultKind(Fortran::common::TypeCategory::Logical)),
+          static_cast<fir::KindTy>(
+              defKinds.GetDefaultKind(Fortran::common::TypeCategory::Real))};
+}
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_SUPPORT_UTILS_H

flang/lib/Lower/Bridge.cpp

+//===-- Bridge.cpp -- bridge to lower to MLIR -----------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/Bridge.h"
+#include "flang/Evaluate/tools.h"
+#include "flang/Lower/CallInterface.h"
+#include "flang/Lower/Mangler.h"
+#include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/SymbolMap.h"
+#include "flang/Lower/Todo.h"
+#include "flang/Optimizer/Support/FIRContext.h"
+#include "mlir/IR/PatternMatch.h"
+#include "mlir/Transforms/RegionUtils.h"
+#include "llvm/Support/CommandLine.h"
+#include "llvm/Support/Debug.h"
+
+#define DEBUG_TYPE "flang-lower-bridge"
+
+static llvm::cl::opt<bool> dumpBeforeFir(
+    "fdebug-dump-pre-fir", llvm::cl::init(false),
+    llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation"));
+
+//===----------------------------------------------------------------------===//
+// FirConverter
+//===----------------------------------------------------------------------===//
+
+namespace {
+
+/// Traverse the pre-FIR tree (PFT) to generate the FIR dialect of MLIR.
+class FirConverter : public Fortran::lower::AbstractConverter {
+public:
+  explicit FirConverter(Fortran::lower::LoweringBridge &bridge)
+      : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {}
+  virtual ~FirConverter() = default;
+
+  /// Convert the PFT to FIR.
+  void run(Fortran::lower::pft::Program &pft) {
+    // Primary translation pass.
+    for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
+      std::visit(
+          Fortran::common::visitors{
+              [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); },
+              [&](Fortran::lower::pft::ModuleLikeUnit &m) {},
+              [&](Fortran::lower::pft::BlockDataUnit &b) {},
+              [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {
+                setCurrentPosition(
+                    d.get<Fortran::parser::CompilerDirective>().source);
+                mlir::emitWarning(toLocation(),
+                                  "ignoring all compiler directives");
+              },
+          },
+          u);
+    }
+  }
+
+  //===--------------------------------------------------------------------===//
+  // AbstractConverter overrides
+  //===--------------------------------------------------------------------===//
+
+  mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final {
+    return lookupSymbol(sym).getAddr();
+  }
+
+  mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr,
+                          mlir::Location *loc = nullptr) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+  mlir::Value genExprValue(const Fortran::lower::SomeExpr &expr,
+                           mlir::Location *loc = nullptr) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+
+  Fortran::evaluate::FoldingContext &getFoldingContext() override final {
+    return foldingContext;
+  }
+
+  mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+  mlir::Type genType(const Fortran::lower::SomeExpr &) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+  mlir::Type genType(Fortran::lower::SymbolRef) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+  mlir::Type genType(Fortran::common::TypeCategory tc) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+  mlir::Type genType(Fortran::common::TypeCategory tc,
+                     int kind) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+  mlir::Type genType(const Fortran::lower::pft::Variable &) override final {
+    TODO_NOLOC("Not implemented. Needed for more complex expression lowering");
+  }
+
+  void setCurrentPosition(const Fortran::parser::CharBlock &position) {
+    if (position != Fortran::parser::CharBlock{})
+      currentPosition = position;
+  }
+
+  //===--------------------------------------------------------------------===//
+  // Utility methods
+  //===--------------------------------------------------------------------===//
+
+  /// Convert a parser CharBlock to a Location
+  mlir::Location toLocation(const Fortran::parser::CharBlock &cb) {
+    return genLocation(cb);
+  }
+
+  mlir::Location toLocation() { return toLocation(currentPosition); }
+  void setCurrentEval(Fortran::lower::pft::Evaluation &eval) {
+    evalPtr = &eval;
+  }
+
+  mlir::Location getCurrentLocation() override final { return toLocation(); }
+
+  /// Generate a dummy location.
+  mlir::Location genUnknownLocation() override final {
+    // Note: builder may not be instantiated yet
+    return mlir::UnknownLoc::get(&getMLIRContext());
+  }
+
+  /// Generate a `Location` from the `CharBlock`.
+  mlir::Location
+  genLocation(const Fortran::parser::CharBlock &block) override final {
+    if (const Fortran::parser::AllCookedSources *cooked =
+            bridge.getCookedSource()) {
+      if (std::optional<std::pair<Fortran::parser::SourcePosition,
+                                  Fortran::parser::SourcePosition>>
+              loc = cooked->GetSourcePositionRange(block)) {
+        // loc is a pair (begin, end); use the beginning position
+        Fortran::parser::SourcePosition &filePos = loc->first;
+        return mlir::FileLineColLoc::get(&getMLIRContext(), filePos.file.path(),
+                                         filePos.line, filePos.column);
+      }
+    }
+    return genUnknownLocation();
+  }
+
+  fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; }
+
+  mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); }
+
+  mlir::MLIRContext &getMLIRContext() override final {
+    return bridge.getMLIRContext();
+  }
+  std::string
+  mangleName(const Fortran::semantics::Symbol &symbol) override final {
+    return Fortran::lower::mangle::mangleName(symbol);
+  }
+
+  const fir::KindMapping &getKindMap() override final {
+    return bridge.getKindMap();
+  }
+
+  /// Return the predicate: "current block does not have a terminator branch".
+  bool blockIsUnterminated() {
+    mlir::Block *currentBlock = builder->getBlock();
+    return currentBlock->empty() ||
+           !currentBlock->back().hasTrait<mlir::OpTrait::IsTerminator>();
+  }
+
+  /// Emit return and cleanup after the function has been translated.
+  void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
+    setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
+    if (funit.isMainProgram())
+      genExitRoutine();
+    funit.finalBlock = nullptr;
+    LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n"
+                            << *builder->getFunction() << '\n');
+    delete builder;
+    builder = nullptr;
+    localSymbols.clear();
+  }
+
+  /// Prepare to translate a new function
+  void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
+    assert(!builder && "expected nullptr");
+    Fortran::lower::CalleeInterface callee(funit, *this);
+    mlir::FuncOp func = callee.addEntryBlockAndMapArguments();
+    func.setVisibility(mlir::SymbolTable::Visibility::Public);
+    builder = new fir::FirOpBuilder(func, bridge.getKindMap());
+    assert(builder && "FirOpBuilder did not instantiate");
+    builder->setInsertionPointToStart(&func.front());
+  }
+
+  /// Lower a procedure (nest).
+  void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
+    setCurrentPosition(funit.getStartingSourceLoc());
+    for (int entryIndex = 0, last = funit.entryPointList.size();
+         entryIndex < last; ++entryIndex) {
+      funit.setActiveEntry(entryIndex);
+      startNewFunction(funit); // the entry point for lowering this procedure
+      endNewFunction(funit);
+    }
+    funit.setActiveEntry(0);
+    for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions)
+      lowerFunc(f); // internal procedure
+  }
+
+private:
+  FirConverter() = delete;
+  FirConverter(const FirConverter &) = delete;
+  FirConverter &operator=(const FirConverter &) = delete;
+
+  //===--------------------------------------------------------------------===//
+  // Helper member functions
+  //===--------------------------------------------------------------------===//
+
+  /// Find the symbol in the local map or return null.
+  Fortran::lower::SymbolBox
+  lookupSymbol(const Fortran::semantics::Symbol &sym) {
+    if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym))
+      return v;
+    return {};
+  }
+
+  //===--------------------------------------------------------------------===//
+  // Termination of symbolically referenced execution units
+  //===--------------------------------------------------------------------===//
+
+  /// END of program
+  ///
+  /// Generate the cleanup block before the program exits
+  void genExitRoutine() {
+    if (blockIsUnterminated())
+      builder->create<mlir::ReturnOp>(toLocation());
+  }
+  void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); }
+
+  //===--------------------------------------------------------------------===//
+
+  Fortran::lower::LoweringBridge &bridge;
+  Fortran::evaluate::FoldingContext foldingContext;
+  fir::FirOpBuilder *builder = nullptr;
+  Fortran::lower::pft::Evaluation *evalPtr = nullptr;
+  Fortran::lower::SymMap localSymbols;
+  Fortran::parser::CharBlock currentPosition;
+};
+
+} // namespace
+
+Fortran::evaluate::FoldingContext
+Fortran::lower::LoweringBridge::createFoldingContext() const {
+  return {getDefaultKinds(), getIntrinsicTable()};
+}
+
+void Fortran::lower::LoweringBridge::lower(
+    const Fortran::parser::Program &prg,
+    const Fortran::semantics::SemanticsContext &semanticsContext) {
+  std::unique_ptr<Fortran::lower::pft::Program> pft =
+      Fortran::lower::createPFT(prg, semanticsContext);
+  if (dumpBeforeFir)
+    Fortran::lower::dumpPFT(llvm::errs(), *pft);
+  FirConverter converter{*this};
+  converter.run(*pft);
+}
+
+Fortran::lower::LoweringBridge::LoweringBridge(
+    mlir::MLIRContext &context,
+    const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
+    const Fortran::evaluate::IntrinsicProcTable &intrinsics,
+    const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple,
+    fir::KindMapping &kindMap)
+    : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked},
+      context{context}, kindMap{kindMap} {
+  // Register the diagnostic handler.
+  context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) {
+    llvm::raw_ostream &os = llvm::errs();
+    switch (diag.getSeverity()) {
+    case mlir::DiagnosticSeverity::Error:
+      os << "error: ";
+      break;
+    case mlir::DiagnosticSeverity::Remark:
+      os << "info: ";
+      break;
+    case mlir::DiagnosticSeverity::Warning:
+      os << "warning: ";
+      break;
+    default:
+      break;
+    }
+    if (!diag.getLocation().isa<UnknownLoc>())
+      os << diag.getLocation() << ": ";
+    os << diag << '\n';
+    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::setKindMapping(*module.get(), kindMap);
+}

flang/lib/Lower/CMakeLists.txt

 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FortranLower
+  Bridge.cpp
+  CallInterface.cpp
   CharacterExpr.cpp
   CharacterRuntime.cpp
   Coarray.cpp
   ConvertType.cpp
   IO.cpp
   Mangler.cpp
   OpenACC.cpp
   OpenMP.cpp
   PFTBuilder.cpp
+  SymbolMap.cpp
 
   DEPENDS
   FIRDialect
   FIRBuilder
   FIRSupport
   FIRTransforms
   ${dialect_libs}
 

flang/lib/Lower/CallInterface.cpp

+//===-- CallInterface.cpp -- Procedure call interface ---------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/CallInterface.h"
+#include "flang/Evaluate/fold.h"
+#include "flang/Lower/Bridge.h"
+#include "flang/Lower/Mangler.h"
+#include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Support/Utils.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Dialect/FIRDialect.h"
+#include "flang/Optimizer/Dialect/FIROpsSupport.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Semantics/symbol.h"
+#include "flang/Semantics/tools.h"
+
+//===----------------------------------------------------------------------===//
+// BIND(C) mangling helpers
+//===----------------------------------------------------------------------===//
+
+// Return the binding label (from BIND(C...)) or the mangled name of a symbol.
+static std::string getMangledName(const Fortran::semantics::Symbol &symbol) {
+  const std::string *bindName = symbol.GetBindName();
+  return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
+}
+
+//===----------------------------------------------------------------------===//
+// Callee side interface implementation
+//===----------------------------------------------------------------------===//
+
+std::string Fortran::lower::CalleeInterface::getMangledName() const {
+  if (funit.isMainProgram())
+    return fir::NameUniquer::doProgramEntry().str();
+  return ::getMangledName(funit.getSubprogramSymbol());
+}
+
+const Fortran::semantics::Symbol *
+Fortran::lower::CalleeInterface::getProcedureSymbol() const {
+  if (funit.isMainProgram())
+    return nullptr;
+  return &funit.getSubprogramSymbol();
+}
+
+mlir::Location Fortran::lower::CalleeInterface::getCalleeLocation() const {
+  // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably
+  // should just stash the location in the funit regardless.
+  return converter.genLocation(funit.getStartingSourceLoc());
+}
+
+mlir::FuncOp Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() {
+  // On the callee side, directly map the mlir::value argument of
+  // the function block to the Fortran symbols.
+  func.addEntryBlock();
+  return func;
+}
+
+//===----------------------------------------------------------------------===//
+// CallInterface implementation: this part is common to both callee and caller
+// sides.
+//===----------------------------------------------------------------------===//
+
+static void addSymbolAttribute(mlir::FuncOp func,
+                               const Fortran::semantics::Symbol &sym,
+                               mlir::MLIRContext &mlirContext) {
+  // Only add this on bind(C) functions for which the symbol is not reflected in
+  // the current context.
+  if (!Fortran::semantics::IsBindCProcedure(sym))
+    return;
+  std::string name =
+      Fortran::lower::mangle::mangleName(sym, /*keepExternalInScope=*/true);
+  func->setAttr(fir::getSymbolAttrName(),
+                mlir::StringAttr::get(&mlirContext, name));
+}
+
+/// Declare drives the different actions to be performed while analyzing the
+/// signature and building/finding the mlir::FuncOp.
+template <typename T>
+void Fortran::lower::CallInterface<T>::declare() {
+  // Create / get funcOp for direct calls. For indirect calls (only meaningful
+  // on the caller side), no funcOp has to be created here. The mlir::Value
+  // holding the indirection is used when creating the fir::CallOp.
+  if (!side().isIndirectCall()) {
+    std::string name = side().getMangledName();
+    mlir::ModuleOp module = converter.getModuleOp();
+    func = fir::FirOpBuilder::getNamedFunction(module, name);
+    if (!func) {
+      mlir::Location loc = side().getCalleeLocation();
+      mlir::FunctionType ty = genFunctionType();
+      func = fir::FirOpBuilder::createFunction(loc, module, name, ty);
+      if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol())
+        addSymbolAttribute(func, *sym, converter.getMLIRContext());
+    }
+  }
+}
+
+template <typename T>
+mlir::FunctionType Fortran::lower::CallInterface<T>::genFunctionType() {
+  return mlir::FunctionType::get(&converter.getMLIRContext(), {}, {});
+}
+
+template class Fortran::lower::CallInterface<Fortran::lower::CalleeInterface>;

flang/lib/Lower/CharacterExpr.cpp

 //===-- CharacterExpr.cpp -------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/CharacterExpr.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Optimizer/Builder/DoLoopHelper.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
 
 //===----------------------------------------------------------------------===//
 // CharacterExprHelper implementation
 //===----------------------------------------------------------------------===//
 
 /// Get fir.char<kind> type with the same kind as inside str.
 static fir::CharacterType getCharacterType(mlir::Type type) {
   if (auto boxType = type.dyn_cast<fir::BoxCharType>())

flang/lib/Lower/Coarray.cpp

 //===-- Coarray.cpp -------------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 ///
 /// Implementation of the lowering of image related constructs and expressions.
 /// Fortran images can form teams, communicate via coarrays, etc.
 ///
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Coarray.h"
-#include "SymbolMap.h"
 #include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/expression.h"
 
 #undef TODO
 #define TODO(MSG)                                                              \
   {                                                                            \
     mlir::emitError(converter.getCurrentLocation(), "not yet implemented")     \

flang/lib/Lower/OpenACC.cpp

if (standaloneDirective.v == llvm::acc::Directive::ACCD_enter_data) {
     genACCEnterDataOp(converter, accClauseList);
   } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_exit_data) {
     genACCExitDataOp(converter, accClauseList);
   } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_init) {
     genACCInitShutdownOp<mlir::acc::InitOp>(converter, accClauseList);
   } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_shutdown) {
     genACCInitShutdownOp<mlir::acc::ShutdownOp>(converter, accClauseList);
   } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_set) {
-    TODO(converter.genLocation(), "OpenACC set directive not lowered yet!");
+    TODO(converter.getCurrentLocation(),
+         "OpenACC set directive not lowered yet!");
   } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_update) {
     genACCUpdateOp(converter, accClauseList);
   }
 }
 
 static void genACC(Fortran::lower::AbstractConverter &converter,
                    Fortran::lower::pft::Evaluation &eval,
                    const Fortran::parser::OpenACCWaitConstruct &waitConstruct) {
void Fortran::lower::genOpenACCConstruct(
 
   std::visit(
       common::visitors{
           [&](const Fortran::parser::OpenACCBlockConstruct &blockConstruct) {
             genACC(converter, eval, blockConstruct);
           },
           [&](const Fortran::parser::OpenACCCombinedConstruct
                   &combinedConstruct) {
-            TODO(converter.genLocation(),
+            TODO(converter.getCurrentLocation(),
                  "OpenACC Combined construct not lowered yet!");
           },
           [&](const Fortran::parser::OpenACCLoopConstruct &loopConstruct) {
             genACC(converter, eval, loopConstruct);
           },
           [&](const Fortran::parser::OpenACCStandaloneConstruct
                   &standaloneConstruct) {
             genACC(converter, eval, standaloneConstruct);
           },
           [&](const Fortran::parser::OpenACCRoutineConstruct
                   &routineConstruct) {
-            TODO(converter.genLocation(),
+            TODO(converter.getCurrentLocation(),
                  "OpenACC Routine construct not lowered yet!");
           },
           [&](const Fortran::parser::OpenACCCacheConstruct &cacheConstruct) {
-            TODO(converter.genLocation(),
+            TODO(converter.getCurrentLocation(),
                  "OpenACC Cache construct not lowered yet!");
           },
           [&](const Fortran::parser::OpenACCWaitConstruct &waitConstruct) {
             genACC(converter, eval, waitConstruct);
           },
           [&](const Fortran::parser::OpenACCAtomicConstruct &atomicConstruct) {
-            TODO(converter.genLocation(),
+            TODO(converter.getCurrentLocation(),
                  "OpenACC Atomic construct not lowered yet!");
           },
       },
       accConstruct.u);
 }

flang/lib/Lower/SymbolMap.h

-//===-- SymbolMap.h -- lowering internal symbol map -------------*- C++ -*-===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_LOWER_SYMBOLMAP_H
-#define FORTRAN_LOWER_SYMBOLMAP_H
-
-#include "flang/Common/idioms.h"
-#include "flang/Common/reference.h"
-#include "flang/Optimizer/Builder/BoxValue.h"
-#include "flang/Optimizer/Dialect/FIRType.h"
-#include "flang/Semantics/symbol.h"
-#include "mlir/IR/Value.h"
-#include "llvm/ADT/ArrayRef.h"
-#include "llvm/ADT/DenseMap.h"
-#include "llvm/ADT/Optional.h"
-#include "llvm/ADT/SmallVector.h"
-#include "llvm/Support/Compiler.h"
-
-namespace Fortran::lower {
-
-//===----------------------------------------------------------------------===//
-// Symbol information
-//===----------------------------------------------------------------------===//
-
-/// A dictionary entry of ssa-values that together compose a variable referenced
-/// by a Symbol. For example, the declaration
-///
-///   CHARACTER(LEN=i) :: c(j1,j2)
-///
-/// is a single variable `c`. This variable is a two-dimensional array of
-/// CHARACTER. It has a starting address and three dynamic properties: the LEN
-/// parameter `i` a runtime value describing the length of the CHARACTER, and
-/// the `j1` and `j2` runtime values, which describe the shape of the array.
-///
-/// The lowering bridge needs to be able to record all four of these ssa-values
-/// in the lookup table to be able to correctly lower Fortran to FIR.
-struct SymbolBox {
-  // For lookups that fail, have a monostate
-  using None = std::monostate;
-
-  // Trivial intrinsic type
-  using Intrinsic = fir::AbstractBox;
-
-  // Array variable that uses bounds notation
-  using FullDim = fir::ArrayBoxValue;
-
-  // CHARACTER type variable with its dependent type LEN parameter
-  using Char = fir::CharBoxValue;
-
-  // CHARACTER array variable using bounds notation
-  using CharFullDim = fir::CharArrayBoxValue;
-
-  // Generalized derived type variable
-  using Derived = fir::BoxValue;
-
-  //===--------------------------------------------------------------------===//
-  // Constructors
-  //===--------------------------------------------------------------------===//
-
-  SymbolBox() : box{None{}} {}
-  template <typename A>
-  SymbolBox(const A &x) : box{x} {}
-
-  operator bool() const { return !std::holds_alternative<None>(box); }
-
-  // This operator returns the address of the boxed value. TODO: consider
-  // eliminating this in favor of explicit conversion.
-  operator mlir::Value() const { return getAddr(); }
-
-  //===--------------------------------------------------------------------===//
-  // Accessors
-  //===--------------------------------------------------------------------===//
-
-  /// Get address of the boxed value. For a scalar, this is the address of the
-  /// scalar. For an array, this is the address of the first element in the
-  /// array, etc.
-  mlir::Value getAddr() const {
-    return std::visit(common::visitors{
-                          [](const None &) { return mlir::Value{}; },
-                          [](const auto &x) { return x.getAddr(); },
-                      },
-                      box);
-  }
-
-  /// Get the LEN type parameter of a CHARACTER boxed value.
-  llvm::Optional<mlir::Value> getCharLen() const {
-    using T = llvm::Optional<mlir::Value>;
-    return std::visit(common::visitors{
-                          [](const Char &x) { return T{x.getLen()}; },
-                          [](const CharFullDim &x) { return T{x.getLen()}; },
-                          [](const auto &) { return T{}; },
-                      },
-                      box);
-  }
-
-  /// Does the boxed value have an intrinsic type?
-  bool isIntrinsic() const {
-    return std::visit(common::visitors{
-                          [](const Intrinsic &) { return true; },
-                          [](const Char &) { return true; },
-                          [](const auto &x) { return false; },
-                      },
-                      box);
-  }
-
-  /// Does the boxed value have a rank greater than zero?
-  bool hasRank() const {
-    return std::visit(
-        common::visitors{
-            [](const Intrinsic &) { return false; },
-            [](const Char &) { return false; },
-            [](const None &) { return false; },
-            [](const auto &x) { return x.getExtents().size() > 0; },
-        },
-        box);
-  }
-
-  /// Does the boxed value have trivial lower bounds (== 1)?
-  bool hasSimpleLBounds() const {
-    if (auto *arr = std::get_if<FullDim>(&box))
-      return arr->getLBounds().empty();
-    if (auto *arr = std::get_if<CharFullDim>(&box))
-      return arr->getLBounds().empty();
-    if (auto *arr = std::get_if<Derived>(&box))
-      return (arr->getExtents().size() > 0) && arr->getLBounds().empty();
-    return false;
-  }
-
-  /// Does the boxed value have a constant shape?
-  bool hasConstantShape() const {
-    if (auto eleTy = fir::dyn_cast_ptrEleTy(getAddr().getType()))
-      if (auto arrTy = eleTy.dyn_cast<fir::SequenceType>())
-        return arrTy.hasConstantShape();
-    return false;
-  }
-
-  /// Get the lbound if the box explicitly contains it.
-  mlir::Value getLBound(unsigned dim) const {
-    return std::visit(
-        common::visitors{
-            [&](const FullDim &box) { return box.getLBounds()[dim]; },
-            [&](const CharFullDim &box) { return box.getLBounds()[dim]; },
-            [&](const Derived &box) { return box.getLBounds()[dim]; },
-            [](const auto &) { return mlir::Value{}; }},
-        box);
-  }
-
-  /// Apply the lambda `func` to this box value.
-  template <typename ON, typename RT>
-  constexpr RT apply(RT(&&func)(const ON &)) const {
-    if (auto *x = std::get_if<ON>(&box))
-      return func(*x);
-    return RT{};
-  }
-
-  std::variant<Intrinsic, FullDim, Char, CharFullDim, Derived, None> box;
-};
-
-//===----------------------------------------------------------------------===//
-// Map of symbol information
-//===----------------------------------------------------------------------===//
-
-/// Helper class to map front-end symbols to their MLIR representation. This
-/// provides a way to lookup the ssa-values that comprise a Fortran symbol's
-/// runtime attributes. These attributes include its address, its dynamic size,
-/// dynamic bounds information for non-scalar entities, dynamic type parameters,
-/// etc.
-class SymMap {
-public:
-  /// Add a trivial symbol mapping to an address.
-  void addSymbol(semantics::SymbolRef sym, mlir::Value value,
-                 bool force = false) {
-    makeSym(sym, SymbolBox::Intrinsic(value), force);
-  }
-
-  /// Add a scalar CHARACTER mapping to an (address, len).
-  void addCharSymbol(semantics::SymbolRef sym, mlir::Value value,
-                     mlir::Value len, bool force = false) {
-    makeSym(sym, SymbolBox::Char(value, len), force);
-  }
-
-  /// Add an array mapping with (address, shape).
-  void addSymbolWithShape(semantics::SymbolRef sym, mlir::Value value,
-                          llvm::ArrayRef<mlir::Value> shape,
-                          bool force = false) {
-    makeSym(sym, SymbolBox::FullDim(value, shape), force);
-  }
-
-  /// Add an array of CHARACTER mapping.
-  void addCharSymbolWithShape(semantics::SymbolRef sym, mlir::Value value,
-                              mlir::Value len,
-                              llvm::ArrayRef<mlir::Value> shape,
-                              bool force = false) {
-    makeSym(sym, SymbolBox::CharFullDim(value, len, shape), force);
-  }
-
-  /// Add an array mapping with bounds notation.
-  void addSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value,
-                           llvm::ArrayRef<mlir::Value> extents,
-                           llvm::ArrayRef<mlir::Value> lbounds,
-                           bool force = false) {
-    makeSym(sym, SymbolBox::FullDim(value, extents, lbounds), force);
-  }
-
-  /// Add an array of CHARACTER with bounds notation.
-  void addCharSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value,
-                               mlir::Value len,
-                               llvm::ArrayRef<mlir::Value> extents,
-                               llvm::ArrayRef<mlir::Value> lbounds,
-                               bool force = false) {
-    makeSym(sym, SymbolBox::CharFullDim(value, len, extents, lbounds), force);
-  }
-
-  /// Find `symbol` and return its value if it appears in the current mappings.
-  SymbolBox lookupSymbol(semantics::SymbolRef sym) {
-    auto iter = symbolMap.find(&*sym);
-    return (iter == symbolMap.end()) ? SymbolBox() : iter->second;
-  }
-
-  /// Remove `sym` from the map.
-  void erase(semantics::SymbolRef sym) { symbolMap.erase(&*sym); }
-
-  /// Remove all symbols from the map.
-  void clear() { symbolMap.clear(); }
-
-  /// Dump the map. For debugging.
-  LLVM_DUMP_METHOD void dump() const;
-
-private:
-  /// Add `symbol` to the current map and bind a `box`.
-  void makeSym(semantics::SymbolRef sym, const SymbolBox &box,
-               bool force = false) {
-    if (force)
-      erase(sym);
-    assert(box && "cannot add an undefined symbol box");
-    symbolMap.try_emplace(&*sym, box);
-  }
-
-  llvm::DenseMap<const semantics::Symbol *, SymbolBox> symbolMap;
-};
-
-} // namespace Fortran::lower
-
-#endif // FORTRAN_LOWER_SYMBOLMAP_H

flang/lib/Lower/SymbolMap.cpp

+//===-- SymbolMap.cpp -----------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Pretty printers for symbol boxes, etc.
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/SymbolMap.h"
+#include "mlir/IR/BuiltinTypes.h"
+#include "llvm/Support/Debug.h"
+
+#define DEBUG_TYPE "flang-lower-symbol-map"
+
+void Fortran::lower::SymMap::addSymbol(Fortran::semantics::SymbolRef sym,
+                                       const fir::ExtendedValue &exv,
+                                       bool force) {
+  exv.match([&](const fir::UnboxedValue &v) { addSymbol(sym, v, force); },
+            [&](const fir::CharBoxValue &v) { makeSym(sym, v, force); },
+            [&](const fir::ArrayBoxValue &v) { makeSym(sym, v, force); },
+            [&](const fir::CharArrayBoxValue &v) { makeSym(sym, v, force); },
+            [&](const fir::BoxValue &v) { makeSym(sym, v, force); },
+            [&](const fir::MutableBoxValue &v) { makeSym(sym, v, force); },
+            [](auto) {
+              llvm::report_fatal_error("value not added to symbol table");
+            });
+}
+
+Fortran::lower::SymbolBox
+Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef sym) {
+  for (auto jmap = symbolMapStack.rbegin(), jend = symbolMapStack.rend();
+       jmap != jend; ++jmap) {
+    auto iter = jmap->find(&*sym);
+    if (iter != jmap->end())
+      return iter->second;
+  }
+  return SymbolBox::None{};
+}
+
+mlir::Value
+Fortran::lower::SymMap::lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var) {
+  for (auto [marker, binding] : llvm::reverse(impliedDoStack))
+    if (var == marker)
+      return binding;
+  return {};
+}
+
+llvm::raw_ostream &
+Fortran::lower::operator<<(llvm::raw_ostream &os,
+                           const Fortran::lower::SymbolBox &symBox) {
+  symBox.match(
+      [&](const Fortran::lower::SymbolBox::None &box) {
+        os << "** symbol not properly mapped **\n";
+      },
+      [&](const Fortran::lower::SymbolBox::Intrinsic &val) {
+        os << val.getAddr() << '\n';
+      },
+      [&](const auto &box) { os << box << '\n'; });
+  return os;
+}
+
+llvm::raw_ostream &
+Fortran::lower::operator<<(llvm::raw_ostream &os,
+                           const Fortran::lower::SymMap &symMap) {
+  os << "Symbol map:\n";
+  for (auto i : llvm::enumerate(symMap.symbolMapStack)) {
+    os << " level " << i.index() << "<{\n";
+    for (auto iter : i.value())
+      os << "  symbol @" << static_cast<const void *>(iter.first) << " ["
+         << *iter.first << "] ->\n    " << iter.second;
+    os << " }>\n";
+  }
+  return os;
+}

flang/test/CMakeLists.txt

configure_lit_site_cfg(
   MAIN_CONFIG
   ${CMAKE_CURRENT_SOURCE_DIR}/NonGtestUnit/lit.cfg.py
 )
 
 set(FLANG_TEST_PARAMS
   flang_site_config=${CMAKE_CURRENT_BINARY_DIR}/lit.site.cfg.py)
 
 set(FLANG_TEST_DEPENDS
-  flang-new llvm-config FileCheck count not module_files fir-opt tco
+  flang-new llvm-config FileCheck count not module_files fir-opt tco bbc
 )
 
 if (FLANG_INCLUDE_TESTS)
   if (FLANG_GTEST_AVAIL)
     list(APPEND FLANG_TEST_DEPENDS FlangUnitTests)
   endif()
 endif()
 

flang/test/Lower/basic-program.f90

+! RUN: bbc %s --pft-test | FileCheck %s
+! RUN: bbc %s -o "-" -emit-fir | FileCheck %s --check-prefix=FIR
+
+program basic
+end program
+
+! CHECK: 1 Program basic
+! CHECK:   1 EndProgramStmt: end program
+! CHECK: End Program basic
+
+! FIR-LABEL: func @_QQmain() {
+! FIR:         return
+! FIR:       }

flang/tools/CMakeLists.txt

 #===-- tools/CMakeLists.txt ------------------------------------------------===#
 #
 # Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 # See https://llvm.org/LICENSE.txt for license information.
 # SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 #
 #===------------------------------------------------------------------------===#
 
+add_subdirectory(bbc)
 add_subdirectory(f18)
 add_subdirectory(flang-driver)
 add_subdirectory(tco)
 add_subdirectory(f18-parse-demo)
 add_subdirectory(fir-opt)

flang/tools/bbc/CMakeLists.txt

+
+add_flang_tool(bbc bbc.cpp
+DEPENDS
+FIROptCodeGenPassIncGen
+)
+
+llvm_update_compile_flags(bbc)
+get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
+target_link_libraries(bbc PRIVATE
+FIRDialect
+FIRSupport
+FIRTransforms
+FIRBuilder
+${dialect_libs}
+MLIRAffineToStandard
+MLIRSCFToStandard
+FortranCommon
+FortranParser
+FortranEvaluate
+FortranSemantics
+FortranLower
+)

flang/tools/bbc/bbc.cpp

+//===- bbc.cpp - Burnside Bridge Compiler -----------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+///
+/// This is a tool for translating Fortran sources to the FIR dialect of MLIR.
+///
+//===----------------------------------------------------------------------===//
+
+#include "flang/Common/Fortran-features.h"
+#include "flang/Common/default-kinds.h"
+#include "flang/Lower/Bridge.h"
+#include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Support/Verifier.h"
+#include "flang/Optimizer/Support/FIRContext.h"
+#include "flang/Optimizer/Support/InitFIR.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Optimizer/Support/KindMapping.h"
+#include "flang/Optimizer/Support/Utils.h"
+#include "flang/Optimizer/Transforms/Passes.h"
+#include "flang/Parser/characters.h"
+#include "flang/Parser/dump-parse-tree.h"
+#include "flang/Parser/message.h"
+#include "flang/Parser/parse-tree-visitor.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/parsing.h"
+#include "flang/Parser/provenance.h"
+#include "flang/Parser/unparse.h"
+#include "flang/Semantics/expression.h"
+#include "flang/Semantics/runtime-type-info.h"
+#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/unparse-with-symbols.h"
+#include "flang/Version.inc"
+#include "mlir/Conversion/SCFToStandard/SCFToStandard.h"
+#include "mlir/IR/AsmState.h"
+#include "mlir/IR/BuiltinOps.h"
+#include "mlir/IR/MLIRContext.h"
+#include "mlir/Parser.h"
+#include "mlir/Pass/Pass.h"
+#include "mlir/Pass/PassManager.h"
+#include "mlir/Pass/PassRegistry.h"
+#include "mlir/Transforms/GreedyPatternRewriteDriver.h"
+#include "mlir/Transforms/Passes.h"
+#include "llvm/Support/CommandLine.h"
+#include "llvm/Support/ErrorOr.h"
+#include "llvm/Support/FileSystem.h"
+#include "llvm/Support/InitLLVM.h"
+#include "llvm/Support/MemoryBuffer.h"
+#include "llvm/Support/Path.h"
+#include "llvm/Support/SourceMgr.h"
+#include "llvm/Support/TargetSelect.h"
+#include "llvm/Support/ToolOutputFile.h"
+#include "llvm/Support/raw_ostream.h"
+
+//===----------------------------------------------------------------------===//
+// Some basic command-line options
+//===----------------------------------------------------------------------===//
+
+static llvm::cl::opt<std::string> inputFilename(llvm::cl::Positional,
+                                                llvm::cl::Required,
+                                                llvm::cl::desc("<input file>"));
+
+static llvm::cl::opt<std::string>
+    outputFilename("o", llvm::cl::desc("Specify the output filename"),
+                   llvm::cl::value_desc("filename"));
+
+static llvm::cl::opt<bool>
+    emitFIR("emit-fir",
+            llvm::cl::desc("Dump the FIR created by lowering and exit"),
+            llvm::cl::init(false));
+
+static llvm::cl::opt<bool> pftDumpTest(
+    "pft-test",
+    llvm::cl::desc("parse the input, create a PFT, dump it, and exit"),
+    llvm::cl::init(false));
+
+#define FLANG_EXCLUDE_CODEGEN
+#include "flang/Tools/CLOptions.inc"
+
+//===----------------------------------------------------------------------===//
+
+using ProgramName = std::string;
+
+// Print the module without the "module { ... }" wrapper.
+static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) {
+  for (auto &op : *mlirModule.getBody())
+    out << op << '\n';
+  out << '\n';
+}
+
+static void registerAllPasses() {
+  fir::support::registerMLIRPassesForFortranTools();
+  fir::registerOptTransformPasses();
+}
+
+//===----------------------------------------------------------------------===//
+// Translate Fortran input to FIR, a dialect of MLIR.
+//===----------------------------------------------------------------------===//
+
+static mlir::LogicalResult convertFortranSourceToMLIR(
+    std::string path, Fortran::parser::Options options,
+    const ProgramName &programPrefix,
+    Fortran::semantics::SemanticsContext &semanticsContext,
+    const mlir::PassPipelineCLParser &passPipeline) {
+
+  // prep for prescan and parse
+  Fortran::parser::Parsing parsing{semanticsContext.allCookedSources()};
+  parsing.Prescan(path, options);
+  if (!parsing.messages().empty() && (parsing.messages().AnyFatalError())) {
+    llvm::errs() << programPrefix << "could not scan " << path << '\n';
+    parsing.messages().Emit(llvm::errs(), parsing.allCooked());
+    return mlir::failure();
+  }
+
+  // parse the input Fortran
+  parsing.Parse(llvm::outs());
+  parsing.messages().Emit(llvm::errs(), parsing.allCooked());
+  if (!parsing.consumedWholeFile()) {
+    parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(),
+                        "parser FAIL (final position)");
+    return mlir::failure();
+  }
+  if ((!parsing.messages().empty() && (parsing.messages().AnyFatalError())) ||
+      !parsing.parseTree().has_value()) {
+    llvm::errs() << programPrefix << "could not parse " << path << '\n';
+    return mlir::failure();
+  }
+
+  // run semantics
+  auto &parseTree = *parsing.parseTree();
+  Fortran::semantics::Semantics semantics(semanticsContext, parseTree);
+  semantics.Perform();
+  semantics.EmitMessages(llvm::errs());
+  if (semantics.AnyFatalError()) {
+    llvm::errs() << programPrefix << "semantic errors in " << path << '\n';
+    return mlir::failure();
+  }
+  Fortran::semantics::RuntimeDerivedTypeTables tables;
+  if (!semantics.AnyFatalError()) {
+    tables =
+        Fortran::semantics::BuildRuntimeDerivedTypeTables(semanticsContext);
+    if (!tables.schemata)
+      llvm::errs() << programPrefix
+                   << "could not find module file for __fortran_type_info\n";
+  }
+
+  if (pftDumpTest) {
+    if (auto ast = Fortran::lower::createPFT(parseTree, semanticsContext)) {
+      Fortran::lower::dumpPFT(llvm::outs(), *ast);
+      return mlir::success();
+    }
+    llvm::errs() << "Pre FIR Tree is NULL.\n";
+    return mlir::failure();
+  }
+
+  // translate to FIR dialect of MLIR
+  mlir::DialectRegistry registry;
+  fir::support::registerNonCodegenDialects(registry);
+  mlir::MLIRContext ctx(registry);
+  fir::support::loadNonCodegenDialects(ctx);
+  auto &defKinds = semanticsContext.defaultKinds();
+  fir::KindMapping kindMap(
+      &ctx, llvm::ArrayRef<fir::KindTy>{fir::fromDefaultKinds(defKinds)});
+  auto burnside = Fortran::lower::LoweringBridge::create(
+      ctx, defKinds, semanticsContext.intrinsics(), parsing.allCooked(), "",
+      kindMap);
+  burnside.lower(parseTree, semanticsContext);
+  mlir::ModuleOp mlirModule = burnside.getModule();
+  std::error_code ec;
+  std::string outputName = outputFilename;
+  if (!outputName.size())
+    outputName = llvm::sys::path::stem(inputFilename).str().append(".mlir");
+  llvm::raw_fd_ostream out(outputName, ec);
+  if (ec)
+    return mlir::emitError(mlir::UnknownLoc::get(&ctx),
+                           "could not open output file ")
+           << outputName;
+
+  // Otherwise run the default passes.
+  mlir::PassManager pm(&ctx, mlir::OpPassManager::Nesting::Implicit);
+  pm.enableVerifier(/*verifyPasses=*/true);
+  mlir::applyPassManagerCLOptions(pm);
+  if (passPipeline.hasAnyOccurrences()) {
+    // run the command-line specified pipeline
+    (void)passPipeline.addToPipeline(pm, [&](const llvm::Twine &msg) {
+      mlir::emitError(mlir::UnknownLoc::get(&ctx)) << msg;
+      return mlir::failure();
+    });
+  } else if (emitFIR) {
+    // --emit-fir: Build the IR, verify it, and dump the IR if the IR passes
+    // verification. Use --dump-module-on-failure to dump invalid IR.
+    pm.addPass(std::make_unique<Fortran::lower::VerifierPass>());
+    if (mlir::failed(pm.run(mlirModule))) {
+      llvm::errs() << "FATAL: verification of lowering to FIR failed";
+      return mlir::failure();
+    }
+    printModule(mlirModule, out);
+    return mlir::success();
+  } else {
+    // run the default canned pipeline
+    pm.addPass(std::make_unique<Fortran::lower::VerifierPass>());
+
+    // Add default optimizer pass pipeline.
+    fir::createDefaultFIROptimizerPassPipeline(pm);
+  }
+
+  if (mlir::succeeded(pm.run(mlirModule))) {
+    // Emit MLIR and do not lower to LLVM IR.
+    printModule(mlirModule, out);
+    return mlir::success();
+  }
+  // Something went wrong. Try to dump the MLIR module.
+  llvm::errs() << "oops, pass manager reported failure\n";
+  return mlir::failure();
+}
+
+int main(int argc, char **argv) {
+  [[maybe_unused]] llvm::InitLLVM y(argc, argv);
+  registerAllPasses();
+
+  mlir::registerMLIRContextCLOptions();
+  mlir::registerPassManagerCLOptions();
+  mlir::PassPipelineCLParser passPipe("", "Compiler passes to run");
+  llvm::cl::ParseCommandLineOptions(argc, argv, "Burnside Bridge Compiler\n");
+
+  ProgramName programPrefix;
+  programPrefix = argv[0] + ": "s;
+
+  Fortran::parser::Options options;
+  options.predefinitions.emplace_back("__flang__", "1");
+  options.predefinitions.emplace_back("__flang_major__",
+                                      FLANG_VERSION_MAJOR_STRING);
+  options.predefinitions.emplace_back("__flang_minor__",
+                                      FLANG_VERSION_MINOR_STRING);
+  options.predefinitions.emplace_back("__flang_patchlevel__",
+                                      FLANG_VERSION_PATCHLEVEL_STRING);
+
+  Fortran::common::IntrinsicTypeDefaultKinds defaultKinds;
+  Fortran::parser::AllSources allSources;
+  Fortran::parser::AllCookedSources allCookedSources(allSources);
+  Fortran::semantics::SemanticsContext semanticsContext{
+      defaultKinds, options.features, allCookedSources};
+
+  return mlir::failed(convertFortranSourceToMLIR(
+      inputFilename, options, programPrefix, semanticsContext, passPipe));
+}