[flang-commits] [flang] e1a1276 - [flang] Initial lowering for empty program
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Fri Jan 28 13:40:03 PST 2022
Author: Valentin Clement
Date: 2022-01-28T22:39:58+01:00
New Revision: e1a12767ee628e179efc8733449f98018a686b4d
URL: https://github.com/llvm/llvm-project/commit/e1a12767ee628e179efc8733449f98018a686b4d
DIFF: https://github.com/llvm/llvm-project/commit/e1a12767ee628e179efc8733449f98018a686b4d.diff
LOG: [flang] Initial lowering for empty program
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.
Reviewed By: kiranchandramohan, schweitz, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D118436
Added:
flang/include/flang/Lower/CallInterface.h
flang/include/flang/Lower/Support/Verifier.h
flang/include/flang/Lower/SymbolMap.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/SymbolMap.cpp
flang/test/Lower/basic-program.f90
flang/tools/bbc/CMakeLists.txt
flang/tools/bbc/bbc.cpp
Modified:
flang/include/flang/Lower/AbstractConverter.h
flang/include/flang/Lower/Bridge.h
flang/include/flang/Lower/PFTBuilder.h
flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
flang/include/flang/Optimizer/Support/Utils.h
flang/lib/Lower/CMakeLists.txt
flang/lib/Lower/CharacterExpr.cpp
flang/lib/Lower/Coarray.cpp
flang/lib/Lower/OpenACC.cpp
flang/test/CMakeLists.txt
flang/tools/CMakeLists.txt
Removed:
flang/lib/Lower/SymbolMap.h
################################################################################
diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h
index 0faecfe8d271e..4b6b7184345a4 100644
--- a/flang/include/flang/Lower/AbstractConverter.h
+++ b/flang/include/flang/Lower/AbstractConverter.h
@@ -5,12 +5,23 @@
// 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;
@@ -22,6 +33,7 @@ namespace common {
template <typename>
class Reference;
}
+
namespace evaluate {
struct DataRef;
template <typename>
@@ -35,7 +47,8 @@ class CharBlock;
}
namespace semantics {
class Symbol;
-}
+class DerivedTypeSpec;
+} // namespace semantics
namespace lower {
namespace pft {
@@ -109,7 +122,7 @@ class AbstractConverter {
/// 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;
@@ -125,10 +138,8 @@ class AbstractConverter {
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;
};
diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h
index dd601d2cb81eb..5398dc44a0d26 100644
--- a/flang/include/flang/Lower/Bridge.h
+++ b/flang/include/flang/Lower/Bridge.h
@@ -50,17 +50,20 @@ 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;
@@ -94,18 +97,20 @@ class LoweringBridge {
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
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
new file mode 100644
index 0000000000000..dc61b0250bbea
--- /dev/null
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -0,0 +1,157 @@
+//===-- 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
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 16abf6bc8f3a4..0e625bf86b99c 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -354,6 +354,13 @@ struct ProgramUnit : ProgramVariant {
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.
///
diff --git a/flang/include/flang/Lower/Support/Verifier.h b/flang/include/flang/Lower/Support/Verifier.h
new file mode 100644
index 0000000000000..26f837029da1e
--- /dev/null
+++ b/flang/include/flang/Lower/Support/Verifier.h
@@ -0,0 +1,34 @@
+//===-- 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
diff --git a/flang/include/flang/Lower/SymbolMap.h b/flang/include/flang/Lower/SymbolMap.h
new file mode 100644
index 0000000000000..31883cacf50a9
--- /dev/null
+++ b/flang/include/flang/Lower/SymbolMap.h
@@ -0,0 +1,347 @@
+//===-- 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
diff --git a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
index 574f286818c3f..d9be2f9da5470 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
+++ b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
@@ -74,6 +74,9 @@ 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
diff --git a/flang/include/flang/Optimizer/Support/Utils.h b/flang/include/flang/Optimizer/Support/Utils.h
index 1f4795961ded7..26783d289cea7 100644
--- a/flang/include/flang/Optimizer/Support/Utils.h
+++ b/flang/include/flang/Optimizer/Support/Utils.h
@@ -13,6 +13,8 @@
#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"
@@ -21,6 +23,22 @@ namespace fir {
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
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
new file mode 100644
index 0000000000000..20756b9252c67
--- /dev/null
+++ b/flang/lib/Lower/Bridge.cpp
@@ -0,0 +1,306 @@
+//===-- 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);
+}
diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt
index 3f697af24ebad..771cc10b76155 100644
--- a/flang/lib/Lower/CMakeLists.txt
+++ b/flang/lib/Lower/CMakeLists.txt
@@ -1,6 +1,8 @@
get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
add_flang_library(FortranLower
+ Bridge.cpp
+ CallInterface.cpp
CharacterExpr.cpp
CharacterRuntime.cpp
Coarray.cpp
@@ -10,6 +12,7 @@ add_flang_library(FortranLower
OpenACC.cpp
OpenMP.cpp
PFTBuilder.cpp
+ SymbolMap.cpp
DEPENDS
FIRDialect
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
new file mode 100644
index 0000000000000..63c65cddcb113
--- /dev/null
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -0,0 +1,106 @@
+//===-- 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
diff erent 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>;
diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp
index ca9082f7b74a0..c262375ae6f98 100644
--- a/flang/lib/Lower/CharacterExpr.cpp
+++ b/flang/lib/Lower/CharacterExpr.cpp
@@ -9,6 +9,7 @@
#include "flang/Lower/CharacterExpr.h"
#include "flang/Lower/ConvertType.h"
#include "flang/Optimizer/Builder/DoLoopHelper.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
//===----------------------------------------------------------------------===//
// CharacterExprHelper implementation
diff --git a/flang/lib/Lower/Coarray.cpp b/flang/lib/Lower/Coarray.cpp
index 70cc7311da29c..f59614b39503f 100644
--- a/flang/lib/Lower/Coarray.cpp
+++ b/flang/lib/Lower/Coarray.cpp
@@ -12,8 +12,8 @@
//===----------------------------------------------------------------------===//
#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"
diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp
index 22f43b610a530..e440bb18e9f07 100644
--- a/flang/lib/Lower/OpenACC.cpp
+++ b/flang/lib/Lower/OpenACC.cpp
@@ -908,7 +908,8 @@ genACC(Fortran::lower::AbstractConverter &converter,
} 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);
}
@@ -1001,7 +1002,7 @@ void Fortran::lower::genOpenACCConstruct(
},
[&](const Fortran::parser::OpenACCCombinedConstruct
&combinedConstruct) {
- TODO(converter.genLocation(),
+ TODO(converter.getCurrentLocation(),
"OpenACC Combined construct not lowered yet!");
},
[&](const Fortran::parser::OpenACCLoopConstruct &loopConstruct) {
@@ -1013,18 +1014,18 @@ void Fortran::lower::genOpenACCConstruct(
},
[&](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!");
},
},
diff --git a/flang/lib/Lower/SymbolMap.cpp b/flang/lib/Lower/SymbolMap.cpp
new file mode 100644
index 0000000000000..2cf5062109afc
--- /dev/null
+++ b/flang/lib/Lower/SymbolMap.cpp
@@ -0,0 +1,78 @@
+//===-- 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;
+}
diff --git a/flang/lib/Lower/SymbolMap.h b/flang/lib/Lower/SymbolMap.h
deleted file mode 100644
index 69ab6d4f27aa6..0000000000000
--- a/flang/lib/Lower/SymbolMap.h
+++ /dev/null
@@ -1,249 +0,0 @@
-//===-- 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
diff --git a/flang/test/CMakeLists.txt b/flang/test/CMakeLists.txt
index 07cb01af975a3..e2725d2c7182e 100644
--- a/flang/test/CMakeLists.txt
+++ b/flang/test/CMakeLists.txt
@@ -46,7 +46,7 @@ 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)
diff --git a/flang/test/Lower/basic-program.f90 b/flang/test/Lower/basic-program.f90
new file mode 100644
index 0000000000000..da693cc02ed18
--- /dev/null
+++ b/flang/test/Lower/basic-program.f90
@@ -0,0 +1,13 @@
+! 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: }
diff --git a/flang/tools/CMakeLists.txt b/flang/tools/CMakeLists.txt
index 5e7fe993b0987..337545ae0d4d7 100644
--- a/flang/tools/CMakeLists.txt
+++ b/flang/tools/CMakeLists.txt
@@ -6,6 +6,7 @@
#
#===------------------------------------------------------------------------===#
+add_subdirectory(bbc)
add_subdirectory(f18)
add_subdirectory(flang-driver)
add_subdirectory(tco)
diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt
new file mode 100644
index 0000000000000..a2e92cf1beb3b
--- /dev/null
+++ b/flang/tools/bbc/CMakeLists.txt
@@ -0,0 +1,22 @@
+
+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
+)
diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp
new file mode 100644
index 0000000000000..1bb20ecf2ea51
--- /dev/null
+++ b/flang/tools/bbc/bbc.cpp
@@ -0,0 +1,253 @@
+//===- 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));
+}
More information about the flang-commits
mailing list