diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -160,10 +160,17 @@ std::optional> &&); std::optional> lower() const; + const Expr *GetLower() const { + return lower_.has_value() ? &lower_->value() : nullptr; + } Triplet &set_lower(Expr &&); std::optional> upper() const; + const Expr *GetUpper() const { + return upper_.has_value() ? &upper_->value() : nullptr; + } Triplet &set_upper(Expr &&); Expr stride() const; // N.B. result is not optional<> + const Expr &GetStride() const { return stride_.value(); } Triplet &set_stride(Expr &&); bool operator==(const Triplet &) const; diff --git a/flang/include/flang/Lower/ComponentPath.h b/flang/include/flang/Lower/ComponentPath.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/ComponentPath.h @@ -0,0 +1,70 @@ +//===-- ComponentPath.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 +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_COMPONENTPATH_H +#define FORTRAN_LOWER_COMPONENTPATH_H + +#include "flang/Lower/IterationSpace.h" +#include "llvm/ADT/SmallVector.h" + +namespace fir { +class ArrayLoadOp; +} +namespace Fortran::evaluate { +class ArrayRef; +} + +namespace Fortran::lower { + +namespace details { +class ImplicitSubscripts {}; +} // namespace details + +using PathComponent = + std::variant; + +/// Collection of components. +/// +/// This class is used both to collect front-end post-order functional Expr +/// trees and their translations to Values to be used in a pre-order list of +/// arguments. +class ComponentPath { +public: + ComponentPath(bool isImplicit) { setPC(isImplicit); } + ComponentPath(bool isImplicit, const evaluate::Substring *ss) + : substring(ss) { + setPC(isImplicit); + } + ComponentPath() = delete; + + bool isSlice() { return !trips.empty() || hasComponents(); } + bool hasComponents() { return !suffixComponents.empty(); } + void clear(); + + llvm::SmallVector reversePath; + const evaluate::Substring *substring = nullptr; + bool applied = false; + + llvm::SmallVector prefixComponents; + llvm::SmallVector trips; + llvm::SmallVector suffixComponents; + std::function pc; + +private: + void setPC(bool isImplicit); +}; + +/// Examine each subscript expression of \p x and return true if and only if any +/// of the subscripts is a vector or has a rank greater than 0. +bool isRankedArrayAccess(const Fortran::evaluate::ArrayRef &x); + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_COMPONENTPATH_H diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -36,6 +36,10 @@ class AbstractConverter; class StatementContext; class SymMap; +class ExplicitIterSpace; +class ImplicitIterSpace; +class StatementContext; + using SomeExpr = Fortran::evaluate::Expr; /// Create an extended expression value. @@ -67,6 +71,44 @@ const evaluate::ProcedureRef &call, SymMap &symMap, StatementContext &stmtCtx); +/// Create the address of the box. +/// \p expr must be the designator of an allocatable/pointer entity. +fir::MutableBoxValue createMutableBox(mlir::Location loc, + AbstractConverter &converter, + const SomeExpr &expr, SymMap &symMap); + +/// Lower an array assignment expression. +/// +/// 1. Evaluate the lhs to determine the rank and how to form the ArrayLoad +/// (e.g., if there is a slicing op). +/// 2. Scan the rhs, creating the ArrayLoads and evaluate the scalar subparts to +/// be added to the map. +/// 3. Create the loop nest and evaluate the elemental expression, threading the +/// results. +/// 4. Copy the resulting array back with ArrayMergeStore to the lhs as +/// determined per step 1. +void createSomeArrayAssignment(AbstractConverter &converter, + const SomeExpr &lhs, const SomeExpr &rhs, + SymMap &symMap, StatementContext &stmtCtx); + +/// Lower an array assignment expression with pre-evaluated left and right +/// hand sides. This implements an array copy taking into account +/// non-contiguity and potential overlaps. +void createSomeArrayAssignment(AbstractConverter &converter, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs, SymMap &symMap, + StatementContext &stmtCtx); + +/// Lower an assignment to an allocatable array, allocating the array if +/// it is not allocated yet or reallocation it if it does not conform +/// with the right hand side. +void createAllocatableArrayAssignment(AbstractConverter &converter, + const SomeExpr &lhs, const SomeExpr &rhs, + ExplicitIterSpace &explicitIterSpace, + ImplicitIterSpace &implicitIterSpace, + SymMap &symMap, + StatementContext &stmtCtx); + // Attribute for an alloca that is a trivial adaptor for converting a value to // pass-by-ref semantics for a VALUE parameter. The optimizer may be able to // eliminate these. diff --git a/flang/include/flang/Lower/DumpEvaluateExpr.h b/flang/include/flang/Lower/DumpEvaluateExpr.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/DumpEvaluateExpr.h @@ -0,0 +1,212 @@ +//===-- Lower/DumpEvaluateExpr.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 +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_DUMPEVALUATEEXPR_H +#define FORTRAN_LOWER_DUMPEVALUATEEXPR_H + +#include "flang/Evaluate/tools.h" +#include "flang/Lower/Support/Utils.h" +#include "llvm/ADT/StringRef.h" +#include "llvm/ADT/Twine.h" + +namespace Fortran::lower { + +/// Class to dump Fortran::evaluate::Expr trees out in a user readable way. +/// +/// FIXME: This can be improved to dump more information in some cases. +class DumpEvaluateExpr { +public: + DumpEvaluateExpr() : outs(llvm::errs()) {} + DumpEvaluateExpr(llvm::raw_ostream &str) : outs(str) {} + + template + static void dump(const A &x) { + DumpEvaluateExpr{}.show(x); + } + template + static void dump(llvm::raw_ostream &stream, const A &x) { + DumpEvaluateExpr{stream}.show(x); + } + +private: + template + void show(const Fortran::common::Indirection &x) { + show(x.value()); + } + template + void show(const Fortran::semantics::SymbolRef x) { + show(*x); + } + template + void show(const std::unique_ptr &x) { + show(x.get()); + } + template + void show(const std::shared_ptr &x) { + show(x.get()); + } + template + void show(const A *x) { + if (x) { + show(*x); + return; + } + print("nullptr"); + } + template + void show(const std::optional &x) { + if (x) { + show(*x); + return; + } + print("None"); + } + template + void show(const std::variant &u) { + std::visit([&](const auto &v) { show(v); }, u); + } + template + void show(const std::vector &x) { + indent("vector"); + for (const auto &v : x) + show(v); + outdent(); + } + void show(const Fortran::evaluate::BOZLiteralConstant &); + void show(const Fortran::evaluate::NullPointer &); + template + void show(const Fortran::evaluate::Constant &x) { + if constexpr (T::category == Fortran::common::TypeCategory::Derived) { + indent("derived constant"); + for (const auto &map : x.values()) + for (const auto &pair : map) + show(pair.second.value()); + outdent(); + } else { + print("constant"); + } + } + void show(const Fortran::semantics::Symbol &symbol); + void show(const Fortran::evaluate::StaticDataObject &); + void show(const Fortran::evaluate::ImpliedDoIndex &); + void show(const Fortran::evaluate::BaseObject &x); + void show(const Fortran::evaluate::Component &x); + void show(const Fortran::evaluate::NamedEntity &x); + void show(const Fortran::evaluate::TypeParamInquiry &x); + void show(const Fortran::evaluate::Triplet &x); + void show(const Fortran::evaluate::Subscript &x); + void show(const Fortran::evaluate::ArrayRef &x); + void show(const Fortran::evaluate::CoarrayRef &x); + void show(const Fortran::evaluate::DataRef &x); + void show(const Fortran::evaluate::Substring &x); + void show(const Fortran::evaluate::ComplexPart &x); + template + void show(const Fortran::evaluate::Designator &x) { + indent("designator"); + show(x.u); + outdent(); + } + template + void show(const Fortran::evaluate::Variable &x) { + indent("variable"); + show(x.u); + outdent(); + } + void show(const Fortran::evaluate::DescriptorInquiry &x); + void show(const Fortran::evaluate::SpecificIntrinsic &); + void show(const Fortran::evaluate::ProcedureDesignator &x); + void show(const Fortran::evaluate::ActualArgument &x); + void show(const Fortran::evaluate::ProcedureRef &x) { + indent("procedure ref"); + show(x.proc()); + show(x.arguments()); + outdent(); + } + template + void show(const Fortran::evaluate::FunctionRef &x) { + indent("function ref"); + show(x.proc()); + show(x.arguments()); + outdent(); + } + template + void show(const Fortran::evaluate::ArrayConstructorValue &x) { + show(x.u); + } + template + void show(const Fortran::evaluate::ArrayConstructorValues &x) { + indent("array constructor value"); + for (auto &v : x) + show(v); + outdent(); + } + template + void show(const Fortran::evaluate::ImpliedDo &x) { + indent("implied do"); + show(x.lower()); + show(x.upper()); + show(x.stride()); + show(x.values()); + outdent(); + } + void show(const Fortran::semantics::ParamValue &x); + void + show(const Fortran::semantics::DerivedTypeSpec::ParameterMapType::value_type + &x); + void show(const Fortran::semantics::DerivedTypeSpec &x); + void show(const Fortran::evaluate::StructureConstructorValues::value_type &x); + void show(const Fortran::evaluate::StructureConstructor &x); + template + void show(const Fortran::evaluate::Operation &op) { + indent("unary op"); + show(op.left()); + outdent(); + } + template + void show(const Fortran::evaluate::Operation &op) { + indent("binary op"); + show(op.left()); + show(op.right()); + outdent(); + } + void + show(const Fortran::evaluate::Relational &x); + template + void show(const Fortran::evaluate::Expr &x) { + indent("expr T"); + show(x.u); + outdent(); + } + + const char *getIndentString() const; + void print(llvm::Twine s); + void indent(llvm::StringRef s); + void outdent(); + + llvm::raw_ostream &outs; + unsigned level = 0; +}; + +LLVM_DUMP_METHOD void +dumpEvExpr(const Fortran::evaluate::Expr &x); +LLVM_DUMP_METHOD void dumpEvExpr( + const Fortran::evaluate::Expr< + Fortran::evaluate::Type> &x); +LLVM_DUMP_METHOD void dumpEvExpr( + const Fortran::evaluate::Expr< + Fortran::evaluate::Type> &x); +LLVM_DUMP_METHOD void dumpEvExpr(const Fortran::evaluate::ArrayRef &x); +LLVM_DUMP_METHOD void dumpEvExpr(const Fortran::evaluate::DataRef &x); +LLVM_DUMP_METHOD void dumpEvExpr(const Fortran::evaluate::Substring &x); +LLVM_DUMP_METHOD void dumpEvExpr( + const Fortran::evaluate::Designator< + Fortran::evaluate::Type> &x); + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_DUMPEVALUATEEXPR_H diff --git a/flang/include/flang/Lower/IterationSpace.h b/flang/include/flang/Lower/IterationSpace.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/IterationSpace.h @@ -0,0 +1,587 @@ +//===-- IterationSpace.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_ITERATIONSPACE_H +#define FORTRAN_LOWER_ITERATIONSPACE_H + +#include "flang/Evaluate/tools.h" +#include "flang/Lower/StatementContext.h" +#include "flang/Lower/SymbolMap.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" + +namespace llvm { +class raw_ostream; +} + +namespace Fortran { +namespace evaluate { +struct SomeType; +template +class Expr; +} // namespace evaluate + +namespace lower { + +using FrontEndExpr = const evaluate::Expr *; +using FrontEndSymbol = const semantics::Symbol *; + +class AbstractConverter; + +unsigned getHashValue(FrontEndExpr x); +bool isEqual(FrontEndExpr x, FrontEndExpr y); +} // namespace lower +} // namespace Fortran + +namespace llvm { +template <> +struct DenseMapInfo { + static inline Fortran::lower::FrontEndExpr getEmptyKey() { + return reinterpret_cast(~0); + } + static inline Fortran::lower::FrontEndExpr getTombstoneKey() { + return reinterpret_cast(~0 - 1); + } + static unsigned getHashValue(Fortran::lower::FrontEndExpr v) { + return Fortran::lower::getHashValue(v); + } + static bool isEqual(Fortran::lower::FrontEndExpr lhs, + Fortran::lower::FrontEndExpr rhs) { + return Fortran::lower::isEqual(lhs, rhs); + } +}; +} // namespace llvm + +namespace Fortran::lower { + +/// Abstraction of the iteration space for building the elemental compute loop +/// of an array(-like) statement. +class IterationSpace { +public: + IterationSpace() = default; + + template + explicit IterationSpace(mlir::Value inArg, mlir::Value outRes, + llvm::iterator_range range) + : inArg{inArg}, outRes{outRes}, indices{range.begin(), range.end()} {} + + explicit IterationSpace(const IterationSpace &from, + llvm::ArrayRef idxs) + : inArg(from.inArg), outRes(from.outRes), element(from.element), + indices(idxs.begin(), idxs.end()) {} + + /// Create a copy of the \p from IterationSpace and prepend the \p prefix + /// values and append the \p suffix values, respectively. + explicit IterationSpace(const IterationSpace &from, + llvm::ArrayRef prefix, + llvm::ArrayRef suffix) + : inArg(from.inArg), outRes(from.outRes), element(from.element) { + indices.assign(prefix.begin(), prefix.end()); + indices.append(from.indices.begin(), from.indices.end()); + indices.append(suffix.begin(), suffix.end()); + } + + bool empty() const { return indices.empty(); } + + /// This is the output value as it appears as an argument in the innermost + /// loop in the nest. The output value is threaded through the loop (and + /// conditionals) to maintain proper SSA form. + mlir::Value innerArgument() const { return inArg; } + + /// This is the output value as it appears as an output value from the + /// outermost loop in the loop nest. The output value is threaded through the + /// loop (and conditionals) to maintain proper SSA form. + mlir::Value outerResult() const { return outRes; } + + /// Returns a vector for the iteration space. This vector is used to access + /// elements of arrays in the compute loop. + llvm::SmallVector iterVec() const { return indices; } + + mlir::Value iterValue(std::size_t i) const { + assert(i < indices.size()); + return indices[i]; + } + + /// Set (rewrite) the Value at a given index. + void setIndexValue(std::size_t i, mlir::Value v) { + assert(i < indices.size()); + indices[i] = v; + } + + void setIndexValues(llvm::ArrayRef vals) { + indices.assign(vals.begin(), vals.end()); + } + + void insertIndexValue(std::size_t i, mlir::Value av) { + assert(i <= indices.size()); + indices.insert(indices.begin() + i, av); + } + + /// Set the `element` value. This is the SSA value that corresponds to an + /// element of the resultant array value. + void setElement(fir::ExtendedValue &&ele) { + assert(!fir::getBase(element) && "result element already set"); + element = ele; + } + + /// Get the value that will be merged into the resultant array. This is the + /// computed value that will be stored to the lhs of the assignment. + mlir::Value getElement() const { + assert(fir::getBase(element) && "element must be set"); + return fir::getBase(element); + } + + /// Get the element as an extended value. + fir::ExtendedValue elementExv() const { return element; } + + void clearIndices() { indices.clear(); } + +private: + mlir::Value inArg; + mlir::Value outRes; + fir::ExtendedValue element; + llvm::SmallVector indices; +}; + +using GenerateElementalArrayFunc = + std::function; + +template +class StackableConstructExpr { +public: + bool empty() const { return stack.empty(); } + + void growStack() { stack.push_back(A{}); } + + /// Bind a front-end expression to a closure. + void bind(FrontEndExpr e, GenerateElementalArrayFunc &&fun) { + vmap.insert({e, std::move(fun)}); + } + + /// Replace the binding of front-end expression `e` with a new closure. + void rebind(FrontEndExpr e, GenerateElementalArrayFunc &&fun) { + vmap.erase(e); + bind(e, std::move(fun)); + } + + /// Get the closure bound to the front-end expression, `e`. + GenerateElementalArrayFunc getBoundClosure(FrontEndExpr e) const { + if (!vmap.count(e)) + llvm::report_fatal_error( + "evaluate::Expr is not in the map of lowered mask expressions"); + return vmap.lookup(e); + } + + /// Has the front-end expression, `e`, been lowered and bound? + bool isLowered(FrontEndExpr e) const { return vmap.count(e); } + + StatementContext &stmtContext() { return stmtCtx; } + +protected: + void shrinkStack() { + assert(!empty()); + stack.pop_back(); + if (empty()) { + stmtCtx.finalize(); + vmap.clear(); + } + } + + // The stack for the construct information. + llvm::SmallVector stack; + + // Map each mask expression back to the temporary holding the initial + // evaluation results. + llvm::DenseMap vmap; + + // Inflate the statement context for the entire construct. We have to cache + // the mask expression results, which are always evaluated first, across the + // entire construct. + StatementContext stmtCtx; +}; + +class ImplicitIterSpace; +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ImplicitIterSpace &); + +/// All array expressions have an implicit iteration space, which is isomorphic +/// to the shape of the base array that facilitates the expression having a +/// non-zero rank. This implied iteration space may be conditionalized +/// (disjunctively) with an if-elseif-else like structure, specifically +/// Fortran's WHERE construct. +/// +/// This class is used in the bridge to collect the expressions from the +/// front end (the WHERE construct mask expressions), forward them for lowering +/// as array expressions in an "evaluate once" (copy-in, copy-out) semantics. +/// See 10.2.3.2p3, 10.2.3.2p13, etc. +class ImplicitIterSpace + : public StackableConstructExpr> { +public: + using Base = StackableConstructExpr>; + using FrontEndMaskExpr = FrontEndExpr; + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const ImplicitIterSpace &); + + LLVM_DUMP_METHOD void dump() const; + + void append(FrontEndMaskExpr e) { + assert(!empty()); + getMasks().back().push_back(e); + } + + llvm::SmallVector getExprs() const { + llvm::SmallVector maskList = getMasks()[0]; + for (size_t i = 1, d = getMasks().size(); i < d; ++i) + maskList.append(getMasks()[i].begin(), getMasks()[i].end()); + return maskList; + } + + /// Add a variable binding, `var`, along with its shape for the mask + /// expression `exp`. + void addMaskVariable(FrontEndExpr exp, mlir::Value var, mlir::Value shape, + mlir::Value header) { + maskVarMap.try_emplace(exp, std::make_tuple(var, shape, header)); + } + + /// Lookup the variable corresponding to the temporary buffer that contains + /// the mask array expression results. + mlir::Value lookupMaskVariable(FrontEndExpr exp) { + return std::get<0>(maskVarMap.lookup(exp)); + } + + /// Lookup the variable containing the shape vector for the mask array + /// expression results. + mlir::Value lookupMaskShapeBuffer(FrontEndExpr exp) { + return std::get<1>(maskVarMap.lookup(exp)); + } + + mlir::Value lookupMaskHeader(FrontEndExpr exp) { + return std::get<2>(maskVarMap.lookup(exp)); + } + + // Stack of WHERE constructs, each building a list of mask expressions. + llvm::SmallVector> &getMasks() { + return stack; + } + const llvm::SmallVector> & + getMasks() const { + return stack; + } + + // Cleanup at the end of a WHERE statement or construct. + void shrinkStack() { + Base::shrinkStack(); + if (stack.empty()) + maskVarMap.clear(); + } + +private: + llvm::DenseMap> + maskVarMap; +}; + +class ExplicitIterSpace; +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ExplicitIterSpace &); + +/// Create all the array_load ops for the explicit iteration space context. The +/// nest of FORALLs must have been analyzed a priori. +void createArrayLoads(AbstractConverter &converter, ExplicitIterSpace &esp, + SymMap &symMap); + +/// Create the array_merge_store ops after the explicit iteration space context +/// is conmpleted. +void createArrayMergeStores(AbstractConverter &converter, + ExplicitIterSpace &esp); +using ExplicitSpaceArrayBases = + std::variant; + +unsigned getHashValue(const ExplicitSpaceArrayBases &x); +bool isEqual(const ExplicitSpaceArrayBases &x, + const ExplicitSpaceArrayBases &y); + +} // namespace Fortran::lower + +namespace llvm { +template <> +struct DenseMapInfo { + static inline Fortran::lower::ExplicitSpaceArrayBases getEmptyKey() { + return reinterpret_cast(~0); + } + static inline Fortran::lower::ExplicitSpaceArrayBases getTombstoneKey() { + return reinterpret_cast(~0 - 1); + } + static unsigned + getHashValue(const Fortran::lower::ExplicitSpaceArrayBases &v) { + return Fortran::lower::getHashValue(v); + } + static bool isEqual(const Fortran::lower::ExplicitSpaceArrayBases &lhs, + const Fortran::lower::ExplicitSpaceArrayBases &rhs) { + return Fortran::lower::isEqual(lhs, rhs); + } +}; +} // namespace llvm + +namespace Fortran::lower { +/// Fortran also allows arrays to be evaluated under constructs which allow the +/// user to explicitly specify the iteration space using concurrent-control +/// expressions. These constructs allow the user to define both an iteration +/// space and explicit access vectors on arrays. These need not be isomorphic. +/// The explicit iteration spaces may be conditionalized (conjunctively) with an +/// "and" structure and may be found in FORALL (and DO CONCURRENT) constructs. +/// +/// This class is used in the bridge to collect a stack of lists of +/// concurrent-control expressions to be used to generate the iteration space +/// and associated masks (if any) for a set of nested FORALL constructs around +/// assignment and WHERE constructs. +class ExplicitIterSpace { +public: + using IterSpaceDim = + std::tuple; + using ConcurrentSpec = + std::pair, FrontEndExpr>; + using ArrayBases = ExplicitSpaceArrayBases; + + friend void createArrayLoads(AbstractConverter &converter, + ExplicitIterSpace &esp, SymMap &symMap); + friend void createArrayMergeStores(AbstractConverter &converter, + ExplicitIterSpace &esp); + + /// Is a FORALL context presently active? + /// If we are lowering constructs/statements nested within a FORALL, then a + /// FORALL context is active. + bool isActive() const { return forallContextOpen != 0; } + + /// Get the statement context. + StatementContext &stmtContext() { return stmtCtx; } + + //===--------------------------------------------------------------------===// + // Analysis support + //===--------------------------------------------------------------------===// + + /// Open a new construct. The analysis phase starts here. + void pushLevel(); + + /// Close the construct. + void popLevel(); + + /// Add new concurrent header control variable symbol. + void addSymbol(FrontEndSymbol sym); + + /// Collect array bases from the expression, `x`. + void exprBase(FrontEndExpr x, bool lhs); + + /// Called at the end of a assignment statement. + void endAssign(); + + /// Return all the active control variables on the stack. + llvm::SmallVector collectAllSymbols(); + + //===--------------------------------------------------------------------===// + // Code gen support + //===--------------------------------------------------------------------===// + + /// Enter a FORALL context. + void enter() { forallContextOpen++; } + + /// Leave a FORALL context. + void leave(); + + void pushLoopNest(std::function lambda) { + ccLoopNest.push_back(lambda); + } + + /// Get the inner arguments that correspond to the output arrays. + mlir::ValueRange getInnerArgs() const { return innerArgs; } + + /// Set the inner arguments for the next loop level. + void setInnerArgs(llvm::ArrayRef args) { + innerArgs.clear(); + for (auto &arg : args) + innerArgs.push_back(arg); + } + + /// Reset the outermost `array_load` arguments to the loop nest. + void resetInnerArgs() { innerArgs = initialArgs; } + + /// Capture the current outermost loop. + void setOuterLoop(fir::DoLoopOp loop) { + clearLoops(); + outerLoop = loop; + } + + /// Sets the inner loop argument at position \p offset to \p val. + void setInnerArg(size_t offset, mlir::Value val) { + assert(offset < innerArgs.size()); + innerArgs[offset] = val; + } + + /// Get the types of the output arrays. + llvm::SmallVector innerArgTypes() const { + llvm::SmallVector result; + for (auto &arg : innerArgs) + result.push_back(arg.getType()); + return result; + } + + /// Create a binding between an Ev::Expr node pointer and a fir::array_load + /// op. This bindings will be used when generating the IR. + void bindLoad(ArrayBases base, fir::ArrayLoadOp load) { + loadBindings.try_emplace(std::move(base), load); + } + + fir::ArrayLoadOp findBinding(const ArrayBases &base) { + return loadBindings.lookup(base); + } + + /// `load` must be a LHS array_load. Returns `llvm::None` on error. + llvm::Optional findArgPosition(fir::ArrayLoadOp load); + + bool isLHS(fir::ArrayLoadOp load) { return findArgPosition(load).hasValue(); } + + /// `load` must be a LHS array_load. Determine the threaded inner argument + /// corresponding to this load. + mlir::Value findArgumentOfLoad(fir::ArrayLoadOp load) { + if (auto opt = findArgPosition(load)) + return innerArgs[*opt]; + llvm_unreachable("array load argument not found"); + } + + size_t argPosition(mlir::Value arg) { + for (auto i : llvm::enumerate(innerArgs)) + if (arg == i.value()) + return i.index(); + llvm_unreachable("inner argument value was not found"); + } + + llvm::Optional getLhsLoad(size_t i) { + assert(i < lhsBases.size()); + if (lhsBases[counter].hasValue()) + return findBinding(lhsBases[counter].getValue()); + return llvm::None; + } + + /// Return the outermost loop in this FORALL nest. + fir::DoLoopOp getOuterLoop() { + assert(outerLoop.hasValue()); + return outerLoop.getValue(); + } + + /// Return the statement context for the entire, outermost FORALL construct. + StatementContext &outermostContext() { return outerContext; } + + /// Generate the explicit loop nest. + void genLoopNest() { + for (auto &lambda : ccLoopNest) + lambda(); + } + + /// Clear the array_load bindings. + void resetBindings() { loadBindings.clear(); } + + /// Get the current counter value. + std::size_t getCounter() const { return counter; } + + /// Increment the counter value to the next assignment statement. + void incrementCounter() { counter++; } + + bool isOutermostForall() const { + assert(forallContextOpen); + return forallContextOpen == 1; + } + + void attachLoopCleanup(std::function fn) { + if (!loopCleanup.hasValue()) { + loopCleanup = fn; + return; + } + std::function oldFn = loopCleanup.getValue(); + loopCleanup = [=](fir::FirOpBuilder &builder) { + oldFn(builder); + fn(builder); + }; + } + + // LLVM standard dump method. + LLVM_DUMP_METHOD void dump() const; + + // Pretty-print. + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const ExplicitIterSpace &); + + /// Finalize the current body statement context. + void finalizeContext() { stmtCtx.finalize(); } + + void appendLoops(const llvm::SmallVector &loops) { + loopStack.push_back(loops); + } + + void clearLoops() { loopStack.clear(); } + + llvm::SmallVector> getLoopStack() const { + return loopStack; + } + +private: + /// Cleanup the analysis results. + void conditionalCleanup(); + + StatementContext outerContext; + + // A stack of lists of front-end symbols. + llvm::SmallVector> symbolStack; + llvm::SmallVector> lhsBases; + llvm::SmallVector> rhsBases; + llvm::DenseMap loadBindings; + + // Stack of lambdas to create the loop nest. + llvm::SmallVector> ccLoopNest; + + // Assignment statement context (inside the loop nest). + StatementContext stmtCtx; + llvm::SmallVector innerArgs; + llvm::SmallVector initialArgs; + llvm::Optional outerLoop; + llvm::SmallVector> loopStack; + llvm::Optional> loopCleanup; + std::size_t forallContextOpen = 0; + std::size_t counter = 0; +}; + +/// Is there a Symbol in common between the concurrent header set and the set +/// of symbols in the expression? +template +bool symbolSetsIntersect(llvm::ArrayRef ctrlSet, + const A &exprSyms) { + for (const auto &sym : exprSyms) + if (std::find(ctrlSet.begin(), ctrlSet.end(), &sym.get()) != ctrlSet.end()) + return true; + return false; +} + +/// Determine if the subscript expression symbols from an Ev::ArrayRef +/// intersects with the set of concurrent control symbols, `ctrlSet`. +template +bool symbolsIntersectSubscripts(llvm::ArrayRef ctrlSet, + const A &subscripts) { + for (auto &sub : subscripts) { + if (const auto *expr = + std::get_if(&sub.u)) + if (symbolSetsIntersect(ctrlSet, evaluate::CollectSymbols(expr->value()))) + return true; + } + return false; +} + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_ITERATIONSPACE_H diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h --- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h +++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h @@ -286,6 +286,11 @@ /// this may create a `fir.shift` op. mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv); + /// Create a slice op extended value. The value to be sliced, `exv`, must be + /// an array. + mlir::Value createSlice(mlir::Location loc, const fir::ExtendedValue &exv, + mlir::ValueRange triples, mlir::ValueRange path); + /// Create a boxed value (Fortran descriptor) to be passed to the runtime. /// \p exv is an extended value holding a memory reference to the object that /// must be boxed. This function will crash if provided something that is not @@ -389,6 +394,13 @@ mlir::Value readExtent(fir::FirOpBuilder &builder, mlir::Location loc, const fir::ExtendedValue &box, unsigned dim); +/// Read or get the lower bound in dimension \p dim of the array described by +/// \p box. If the lower bound is left default in the ExtendedValue, +/// \p defaultValue will be returned. +mlir::Value readLowerBound(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &box, unsigned dim, + mlir::Value defaultValue); + /// Read extents from \p box. llvm::SmallVector readExtents(fir::FirOpBuilder &builder, mlir::Location loc, @@ -447,6 +459,35 @@ mlir::Value createZeroValue(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type type); +//===--------------------------------------------------------------------===// +// ExtendedValue helpers +//===--------------------------------------------------------------------===// + +/// Return the extended value for a component of a derived type instance given +/// the address of the component. +fir::ExtendedValue componentToExtendedValue(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value component); + +/// Given the address of an array element and the ExtendedValue describing the +/// array, returns the ExtendedValue describing the array element. The purpose +/// is to propagate the length parameters of the array to the element. +/// This can be used for elements of `array` or `array(i:j:k)`. If \p element +/// belongs to an array section `array%x` whose base is \p array, +/// arraySectionElementToExtendedValue must be used instead. +fir::ExtendedValue arrayElementToExtendedValue(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &array, + mlir::Value element); + +/// Build the ExtendedValue for \p element that is an element of an array or +/// array section with \p array base (`array` or `array(i:j:k)%x%y`). +/// If it is an array section, \p slice must be provided and be a fir::SliceOp +/// that describes the section. +fir::ExtendedValue arraySectionElementToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice); + } // namespace fir::factory #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H diff --git a/flang/include/flang/Optimizer/Builder/Factory.h b/flang/include/flang/Optimizer/Builder/Factory.h --- a/flang/include/flang/Optimizer/Builder/Factory.h +++ b/flang/include/flang/Optimizer/Builder/Factory.h @@ -31,6 +31,21 @@ return "Fortran.offsets"; } +/// Get extents from fir.shape/fir.shape_shift op. Empty result if +/// \p shapeVal is empty or is a fir.shift. +inline std::vector getExtents(mlir::Value shapeVal) { + if (shapeVal) + if (auto *shapeOp = shapeVal.getDefiningOp()) { + if (auto shOp = mlir::dyn_cast(shapeOp)) { + auto operands = shOp.getExtents(); + return {operands.begin(), operands.end()}; + } + if (auto shOp = mlir::dyn_cast(shapeOp)) + return shOp.getExtents(); + } + return {}; +} + /// Get origins from fir.shape_shift/fir.shift op. Empty result if /// \p shapeVal is empty or is a fir.shape. inline std::vector getOrigins(mlir::Value shapeVal) { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -16,6 +16,7 @@ #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/ConvertVariable.h" +#include "flang/Lower/IterationSpace.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" @@ -517,7 +518,7 @@ if (assign.lhs.Rank() > 0) { // Array assignment // See Fortran 2018 10.2.1.3 p5, p6, and p7 - TODO(toLocation(), "Array assignment"); + genArrayAssignment(assign, stmtCtx); return; } @@ -835,6 +836,26 @@ TODO(toLocation(), "LockStmt lowering"); } + /// Generate an array assignment. + /// This is an assignment expression with rank > 0. The assignment may or may + /// not be in a WHERE and/or FORALL context. + void genArrayAssignment(const Fortran::evaluate::Assignment &assign, + Fortran::lower::StatementContext &stmtCtx) { + if (isWholeAllocatable(assign.lhs)) { + // Assignment to allocatables may require the lhs to be + // deallocated/reallocated. See Fortran 2018 10.2.1.3 p3 + Fortran::lower::createAllocatableArrayAssignment( + *this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace, + localSymbols, stmtCtx); + return; + } + + // No masks and the iteration space is implied by the array, so create a + // simple array assignment. + Fortran::lower::createSomeArrayAssignment(*this, assign.lhs, assign.rhs, + localSymbols, stmtCtx); + } + void genFIR(const Fortran::parser::WhereConstruct &c) { TODO(toLocation(), "WhereConstruct lowering"); } @@ -1047,6 +1068,8 @@ /// Tuple of host assoicated variables. mlir::Value hostAssocTuple; + Fortran::lower::ImplicitIterSpace implicitIterSpace; + Fortran::lower::ExplicitIterSpace explicitIterSpace; }; } // namespace diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -9,6 +9,9 @@ ConvertType.cpp ConvertVariable.cpp IntrinsicCall.cpp + ComponentPath.cpp + DumpEvaluateExpr.cpp + IterationSpace.cpp Mangler.cpp OpenACC.cpp OpenMP.cpp diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -601,20 +601,22 @@ fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) { fir::SequenceType::Shape bounds; - for (Fortran::evaluate::MaybeExtentExpr extentExpr : shape) { - fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent(); - if (std::optional constantExtent = - toInt64(std::move(extentExpr))) - extent = *constantExtent; - bounds.push_back(extent); + for (const std::optional &extent : shape) { + fir::SequenceType::Extent bound = fir::SequenceType::getUnknownExtent(); + if (std::optional i = toInt64(extent)) + bound = *i; + bounds.emplace_back(bound); } return bounds; } - - template - std::optional toInt64(A &&expr) { - return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( - getConverter().getFoldingContext(), std::move(expr))); + std::optional + toInt64(std::optional< + Fortran::evaluate::Expr> + expr) { + if (expr) + return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( + getConverter().getFoldingContext(), toEvExpr(*expr))); + return std::nullopt; } /// Return a vector with an attribute with the name of the argument if this diff --git a/flang/lib/Lower/ComponentPath.cpp b/flang/lib/Lower/ComponentPath.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/ComponentPath.cpp @@ -0,0 +1,53 @@ +//===-- ComponentPath.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/ComponentPath.h" + +static std::function< + Fortran::lower::IterationSpace(const Fortran::lower::IterationSpace &)> +getIdentityFunc() { + return [](const Fortran::lower::IterationSpace &s) { return s; }; +} + +static std::function< + Fortran::lower::IterationSpace(const Fortran::lower::IterationSpace &)> +getNullaryFunc() { + return [](const Fortran::lower::IterationSpace &s) { + Fortran::lower::IterationSpace newIters(s); + newIters.clearIndices(); + return newIters; + }; +} + +void Fortran::lower::ComponentPath::clear() { + reversePath.clear(); + substring = nullptr; + applied = false; + prefixComponents.clear(); + trips.clear(); + suffixComponents.clear(); + pc = getIdentityFunc(); +} + +bool Fortran::lower::isRankedArrayAccess(const Fortran::evaluate::ArrayRef &x) { + for (const Fortran::evaluate::Subscript &sub : x.subscript()) { + if (std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::Triplet &) { return true; }, + [&](const Fortran::evaluate::IndirectSubscriptIntegerExpr &e) { + return e.value().Rank() > 0; + }}, + sub.u)) + return true; + } + return false; +} + +void Fortran::lower::ComponentPath::setPC(bool isImplicit) { + pc = isImplicit ? getIdentityFunc() : getNullaryFunc(); +} diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -15,13 +15,17 @@ #include "flang/Evaluate/traverse.h" #include "flang/Lower/AbstractConverter.h" #include "flang/Lower/CallInterface.h" +#include "flang/Lower/ComponentPath.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/ConvertVariable.h" +#include "flang/Lower/DumpEvaluateExpr.h" #include "flang/Lower/IntrinsicCall.h" #include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" #include "flang/Lower/Todo.h" #include "flang/Optimizer/Builder/Complex.h" +#include "flang/Optimizer/Builder/Factory.h" +#include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Semantics/expression.h" #include "flang/Semantics/symbol.h" @@ -43,6 +47,68 @@ // to the correct FIR representation in SSA form. //===----------------------------------------------------------------------===// +/// The various semantics of a program constituent (or a part thereof) as it may +/// appear in an expression. +/// +/// Given the following Fortran declarations. +/// ```fortran +/// REAL :: v1, v2, v3 +/// REAL, POINTER :: vp1 +/// REAL :: a1(c), a2(c) +/// REAL ELEMENTAL FUNCTION f1(arg) ! array -> array +/// FUNCTION f2(arg) ! array -> array +/// vp1 => v3 ! 1 +/// v1 = v2 * vp1 ! 2 +/// a1 = a1 + a2 ! 3 +/// a1 = f1(a2) ! 4 +/// a1 = f2(a2) ! 5 +/// ``` +/// +/// In line 1, `vp1` is a BoxAddr to copy a box value into. The box value is +/// constructed from the DataAddr of `v3`. +/// In line 2, `v1` is a DataAddr to copy a value into. The value is constructed +/// from the DataValue of `v2` and `vp1`. DataValue is implicitly a double +/// dereference in the `vp1` case. +/// In line 3, `a1` and `a2` on the rhs are RefTransparent. The `a1` on the lhs +/// is CopyInCopyOut as `a1` is replaced elementally by the additions. +/// In line 4, `a2` can be RefTransparent, ByValueArg, RefOpaque, or BoxAddr if +/// `arg` is declared as C-like pass-by-value, VALUE, INTENT(?), or ALLOCATABLE/ +/// POINTER, respectively. `a1` on the lhs is CopyInCopyOut. +/// In line 5, `a2` may be DataAddr or BoxAddr assuming f2 is transformational. +/// `a1` on the lhs is again CopyInCopyOut. +enum class ConstituentSemantics { + // Scalar data reference semantics. + // + // For these let `v` be the location in memory of a variable with value `x` + DataValue, // refers to the value `x` + DataAddr, // refers to the address `v` + BoxValue, // refers to a box value containing `v` + BoxAddr, // refers to the address of a box value containing `v` + + // Array data reference semantics. + // + // For these let `a` be the location in memory of a sequence of value `[xs]`. + // Let `x_i` be the `i`-th value in the sequence `[xs]`. + + // Referentially transparent. Refers to the array's value, `[xs]`. + RefTransparent, + // Refers to an ephemeral address `tmp` containing value `x_i` (15.5.2.3.p7 + // note 2). (Passing a copy by reference to simulate pass-by-value.) + ByValueArg, + // Refers to the merge of array value `[xs]` with another array value `[ys]`. + // This merged array value will be written into memory location `a`. + CopyInCopyOut, + // Similar to CopyInCopyOut but `a` may be a transient projection (rather than + // a whole array). + ProjectedCopyInCopyOut, + // Similar to ProjectedCopyInCopyOut, except the merge value is not assigned + // automatically by the framework. Instead, and address for `[xs]` is made + // accessible so that custom assignments to `[xs]` can be implemented. + CustomCopyInCopyOut, + // Referentially opaque. Refers to the address of `x_i`. + RefOpaque +}; + /// Place \p exv in memory if it is not already a memory reference. If /// \p forceValueType is provided, the value is first casted to the provided /// type before being stored (this is mainly intended for logicals whose value @@ -125,6 +191,16 @@ return true; return false; } +template +static bool isElementalProcWithArrayArgs(const Fortran::evaluate::Expr &) { + return false; +} +template <> +bool isElementalProcWithArrayArgs(const Fortran::lower::SomeExpr &x) { + if (const auto *procRef = std::get_if(&x.u)) + return isElementalProcWithArrayArgs(*procRef); + return false; +} /// If \p arg is the address of a function with a denoted host-association tuple /// argument, then return the host-associations tuple value of the current @@ -215,7 +291,7 @@ return symMap.lookupSymbol(*sym).toExtendedValue(); }, [&](const Fortran::evaluate::Component &comp) -> ExtValue { - TODO(getLoc(), "genMutableBoxValueImpl Component"); + return genComponent(comp); }, [&](const auto &) -> ExtValue { fir::emitFatalError(getLoc(), @@ -564,7 +640,17 @@ } ExtValue genval(const Fortran::evaluate::Subscript &subs) { - TODO(getLoc(), "genval Subscript"); + if (auto *s = std::get_if( + &subs.u)) { + if (s->value().Rank() > 0) + fir::emitFatalError(getLoc(), "vector subscript is not scalar"); + return {genval(s->value())}; + } + fir::emitFatalError(getLoc(), "subscript triple notation is not scalar"); + } + + ExtValue genSubscript(const Fortran::evaluate::Subscript &subs) { + return genval(subs); } ExtValue gen(const Fortran::evaluate::DataRef &dref) { @@ -574,6 +660,56 @@ TODO(getLoc(), "genval DataRef"); } + // Helper function to turn the Component structure into a list of nested + // components, ordered from largest/leftmost to smallest/rightmost: + // - where only the smallest/rightmost item may be allocatable or a pointer + // (nested allocatable/pointer components require nested coordinate_of ops) + // - that does not contain any parent components + // (the front end places parent components directly in the object) + // Return the object used as the base coordinate for the component chain. + static Fortran::evaluate::DataRef const * + reverseComponents(const Fortran::evaluate::Component &cmpt, + std::list &list) { + if (!cmpt.GetLastSymbol().test( + Fortran::semantics::Symbol::Flag::ParentComp)) + list.push_front(&cmpt); + return std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::Component &x) { + if (Fortran::semantics::IsAllocatableOrPointer(x.GetLastSymbol())) + return &cmpt.base(); + return reverseComponents(x, list); + }, + [&](auto &) { return &cmpt.base(); }, + }, + cmpt.base().u); + } + + // Return the coordinate of the component reference + ExtValue genComponent(const Fortran::evaluate::Component &cmpt) { + std::list list; + const Fortran::evaluate::DataRef *base = reverseComponents(cmpt, list); + llvm::SmallVector coorArgs; + ExtValue obj = gen(*base); + mlir::Type ty = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(obj).getType()); + mlir::Location loc = getLoc(); + auto fldTy = fir::FieldType::get(&converter.getMLIRContext()); + // FIXME: need to thread the LEN type parameters here. + for (const Fortran::evaluate::Component *field : list) { + auto recTy = ty.cast(); + const Fortran::semantics::Symbol &sym = field->GetLastSymbol(); + llvm::StringRef name = toStringRef(sym.name()); + coorArgs.push_back(builder.create( + loc, fldTy, name, recTy, fir::getTypeParams(obj))); + ty = recTy.getType(name); + } + ty = builder.getRefType(ty); + return fir::factory::componentToExtendedValue( + builder, loc, + builder.create(loc, ty, fir::getBase(obj), + coorArgs)); + } + ExtValue gen(const Fortran::evaluate::Component &cmpt) { TODO(getLoc(), "gen Component"); } @@ -585,8 +721,53 @@ TODO(getLoc(), "genval Bound"); } + /// Return lower bounds of \p box in dimension \p dim. The returned value + /// has type \ty. + mlir::Value getLBound(const ExtValue &box, unsigned dim, mlir::Type ty) { + assert(box.rank() > 0 && "must be an array"); + mlir::Location loc = getLoc(); + mlir::Value one = builder.createIntegerConstant(loc, ty, 1); + mlir::Value lb = fir::factory::readLowerBound(builder, loc, box, dim, one); + return builder.createConvert(loc, ty, lb); + } + + /// Lower an ArrayRef to a fir.coordinate_of given its lowered base. + ExtValue genCoordinateOp(const ExtValue &array, + const Fortran::evaluate::ArrayRef &aref) { + mlir::Location loc = getLoc(); + // References to array of rank > 1 with non constant shape that are not + // fir.box must be collapsed into an offset computation in lowering already. + // The same is needed with dynamic length character arrays of all ranks. + mlir::Type baseType = + fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(array).getType()); + if ((array.rank() > 1 && fir::hasDynamicSize(baseType)) || + fir::characterWithDynamicLen(fir::unwrapSequenceType(baseType))) + if (!array.getBoxOf()) + TODO(getLoc(), "genOffsetAndCoordinateOp"); + // Generate a fir.coordinate_of with zero based array indexes. + llvm::SmallVector args; + for (const auto &subsc : llvm::enumerate(aref.subscript())) { + ExtValue subVal = genSubscript(subsc.value()); + assert(fir::isUnboxedValue(subVal) && "subscript must be simple scalar"); + mlir::Value val = fir::getBase(subVal); + mlir::Type ty = val.getType(); + mlir::Value lb = getLBound(array, subsc.index(), ty); + args.push_back(builder.create(loc, ty, val, lb)); + } + + mlir::Value base = fir::getBase(array); + auto seqTy = + fir::dyn_cast_ptrOrBoxEleTy(base.getType()).cast(); + assert(args.size() == seqTy.getDimension()); + mlir::Type ty = builder.getRefType(seqTy.getEleTy()); + auto addr = builder.create(loc, ty, base, args); + return fir::factory::arrayElementToExtendedValue(builder, loc, array, addr); + } + ExtValue gen(const Fortran::evaluate::ArrayRef &aref) { - TODO(getLoc(), "gen ArrayRef"); + ExtValue base = aref.base().IsSymbol() ? gen(aref.base().GetFirstSymbol()) + : gen(aref.base().GetComponent()); + return genCoordinateOp(base, aref); } ExtValue genval(const Fortran::evaluate::ArrayRef &aref) { TODO(getLoc(), "genval ArrayRef"); @@ -1275,6 +1456,1093 @@ }; } // namespace +// Helper for changing the semantics in a given context. Preserves the current +// semantics which is resumed when the "push" goes out of scope. +#define PushSemantics(PushVal) \ + [[maybe_unused]] auto pushSemanticsLocalVariable##__LINE__ = \ + Fortran::common::ScopedSet(semant, PushVal); + +static bool isAdjustedArrayElementType(mlir::Type t) { + return fir::isa_char(t) || fir::isa_derived(t) || t.isa(); +} + +/// Build an ExtendedValue from a fir.array without actually setting +/// the actual extents and lengths. This is only to allow their propagation as +/// ExtendedValue without triggering verifier failures when propagating +/// character/arrays as unboxed values. Only the base of the resulting +/// ExtendedValue should be used, it is undefined to use the length or extents +/// of the extended value returned, +inline static fir::ExtendedValue +convertToArrayBoxValue(mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Value val, mlir::Value len) { + mlir::Type ty = fir::unwrapRefType(val.getType()); + mlir::IndexType idxTy = builder.getIndexType(); + auto seqTy = ty.cast(); + auto undef = builder.create(loc, idxTy); + llvm::SmallVector extents(seqTy.getDimension(), undef); + if (fir::isa_char(seqTy.getEleTy())) + return fir::CharArrayBoxValue(val, len ? len : undef, extents); + return fir::ArrayBoxValue(val, extents); +} + +//===----------------------------------------------------------------------===// +// +// Lowering of array expressions. +// +//===----------------------------------------------------------------------===// + +namespace { +class ArrayExprLowering { + using ExtValue = fir::ExtendedValue; + + /// Structure to keep track of lowered array operands in the + /// array expression. Useful to later deduce the shape of the + /// array expression. + struct ArrayOperand { + /// Array base (can be a fir.box). + mlir::Value memref; + /// ShapeOp, ShapeShiftOp or ShiftOp + mlir::Value shape; + /// SliceOp + mlir::Value slice; + /// Can this operand be absent ? + bool mayBeAbsent = false; + }; + + using ImplicitSubscripts = Fortran::lower::details::ImplicitSubscripts; + using PathComponent = Fortran::lower::PathComponent; + + /// Active iteration space. + using IterationSpace = Fortran::lower::IterationSpace; + using IterSpace = const Fortran::lower::IterationSpace &; + + /// Current continuation. Function that will generate IR for a single + /// iteration of the pending iterative loop structure. + using CC = Fortran::lower::GenerateElementalArrayFunc; + + /// Projection continuation. Function that will project one iteration space + /// into another. + using PC = std::function; + using ArrayBaseTy = + std::variant; + using ComponentPath = Fortran::lower::ComponentPath; + +public: + //===--------------------------------------------------------------------===// + // Regular array assignment + //===--------------------------------------------------------------------===// + + /// Entry point for array assignments. Both the left-hand and right-hand sides + /// can either be ExtendedValue or evaluate::Expr. + template + static void lowerArrayAssignment(Fortran::lower::AbstractConverter &converter, + Fortran::lower::SymMap &symMap, + Fortran::lower::StatementContext &stmtCtx, + const TL &lhs, const TR &rhs) { + ArrayExprLowering ael{converter, stmtCtx, symMap, + ConstituentSemantics::CopyInCopyOut}; + ael.lowerArrayAssignment(lhs, rhs); + } + + template + void lowerArrayAssignment(const TL &lhs, const TR &rhs) { + mlir::Location loc = getLoc(); + /// Here the target subspace is not necessarily contiguous. The ArrayUpdate + /// continuation is implicitly returned in `ccStoreToDest` and the ArrayLoad + /// in `destination`. + PushSemantics(ConstituentSemantics::ProjectedCopyInCopyOut); + ccStoreToDest = genarr(lhs); + determineShapeOfDest(lhs); + semant = ConstituentSemantics::RefTransparent; + ExtValue exv = lowerArrayExpression(rhs); + if (explicitSpaceIsActive()) { + explicitSpace->finalizeContext(); + builder.create(loc, fir::getBase(exv)); + } else { + builder.create( + loc, destination, fir::getBase(exv), destination.getMemref(), + destination.getSlice(), destination.getTypeparams()); + } + } + + //===--------------------------------------------------------------------===// + // Array assignment to allocatable array + //===--------------------------------------------------------------------===// + + /// Entry point for assignment to allocatable array. + static void lowerAllocatableArrayAssignment( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx, + const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs, + Fortran::lower::ExplicitIterSpace &explicitSpace, + Fortran::lower::ImplicitIterSpace &implicitSpace) { + ArrayExprLowering ael(converter, stmtCtx, symMap, + ConstituentSemantics::CopyInCopyOut, &explicitSpace, + &implicitSpace); + ael.lowerAllocatableArrayAssignment(lhs, rhs); + } + + /// Assignment to allocatable array. + /// + /// The semantics are reverse that of a "regular" array assignment. The rhs + /// defines the iteration space of the computation and the lhs is + /// resized/reallocated to fit if necessary. + void lowerAllocatableArrayAssignment(const Fortran::lower::SomeExpr &lhs, + const Fortran::lower::SomeExpr &rhs) { + // With assignment to allocatable, we want to lower the rhs first and use + // its shape to determine if we need to reallocate, etc. + mlir::Location loc = getLoc(); + // FIXME: If the lhs is in an explicit iteration space, the assignment may + // be to an array of allocatable arrays rather than a single allocatable + // array. + fir::MutableBoxValue mutableBox = + createMutableBox(loc, converter, lhs, symMap); + mlir::Type resultTy = converter.genType(rhs); + if (rhs.Rank() > 0) + determineShapeOfDest(rhs); + auto rhsCC = [&]() { + PushSemantics(ConstituentSemantics::RefTransparent); + return genarr(rhs); + }(); + + llvm::SmallVector lengthParams; + // Currently no safe way to gather length from rhs (at least for + // character, it cannot be taken from array_loads since it may be + // changed by concatenations). + if ((mutableBox.isCharacter() && !mutableBox.hasNonDeferredLenParams()) || + mutableBox.isDerivedWithLengthParameters()) + TODO(loc, "gather rhs length parameters in assignment to allocatable"); + + // The allocatable must take lower bounds from the expr if it is + // reallocated and the right hand side is not a scalar. + const bool takeLboundsIfRealloc = rhs.Rank() > 0; + llvm::SmallVector lbounds; + // When the reallocated LHS takes its lower bounds from the RHS, + // they will be non default only if the RHS is a whole array + // variable. Otherwise, lbounds is left empty and default lower bounds + // will be used. + if (takeLboundsIfRealloc && + Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(rhs)) { + assert(arrayOperands.size() == 1 && + "lbounds can only come from one array"); + std::vector lbs = + fir::factory::getOrigins(arrayOperands[0].shape); + lbounds.append(lbs.begin(), lbs.end()); + } + fir::factory::MutableBoxReallocation realloc = + fir::factory::genReallocIfNeeded(builder, loc, mutableBox, destShape, + lengthParams); + // Create ArrayLoad for the mutable box and save it into `destination`. + PushSemantics(ConstituentSemantics::ProjectedCopyInCopyOut); + ccStoreToDest = genarr(realloc.newValue); + // If the rhs is scalar, get shape from the allocatable ArrayLoad. + if (destShape.empty()) + destShape = getShape(destination); + // Finish lowering the loop nest. + assert(destination && "destination must have been set"); + ExtValue exv = lowerArrayExpression(rhsCC, resultTy); + if (explicitSpaceIsActive()) { + explicitSpace->finalizeContext(); + builder.create(loc, fir::getBase(exv)); + } else { + builder.create( + loc, destination, fir::getBase(exv), destination.getMemref(), + destination.getSlice(), destination.getTypeparams()); + } + fir::factory::finalizeRealloc(builder, loc, mutableBox, lbounds, + takeLboundsIfRealloc, realloc); + } + + /// Entry point into lowering an expression with rank. This entry point is for + /// lowering a rhs expression, for example. (RefTransparent semantics.) + static ExtValue + lowerNewArrayExpression(Fortran::lower::AbstractConverter &converter, + Fortran::lower::SymMap &symMap, + Fortran::lower::StatementContext &stmtCtx, + const Fortran::lower::SomeExpr &expr) { + ArrayExprLowering ael{converter, stmtCtx, symMap}; + ael.determineShapeOfDest(expr); + ExtValue loopRes = ael.lowerArrayExpression(expr); + fir::ArrayLoadOp dest = ael.destination; + mlir::Value tempRes = dest.getMemref(); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::Location loc = converter.getCurrentLocation(); + builder.create(loc, dest, fir::getBase(loopRes), + tempRes, dest.getSlice(), + dest.getTypeparams()); + + auto arrTy = + fir::dyn_cast_ptrEleTy(tempRes.getType()).cast(); + if (auto charTy = + arrTy.getEleTy().template dyn_cast()) { + if (fir::characterWithDynamicLen(charTy)) + TODO(loc, "CHARACTER does not have constant LEN"); + mlir::Value len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), charTy.getLen()); + return fir::CharArrayBoxValue(tempRes, len, dest.getExtents()); + } + return fir::ArrayBoxValue(tempRes, dest.getExtents()); + } + + // FIXME: should take multiple inner arguments. + std::pair + genImplicitLoops(mlir::ValueRange shape, mlir::Value innerArg) { + mlir::Location loc = getLoc(); + mlir::IndexType idxTy = builder.getIndexType(); + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); + llvm::SmallVector loopUppers; + + // Convert any implied shape to closed interval form. The fir.do_loop will + // run from 0 to `extent - 1` inclusive. + for (auto extent : shape) + loopUppers.push_back( + builder.create(loc, extent, one)); + + // Iteration space is created with outermost columns, innermost rows + llvm::SmallVector loops; + + const std::size_t loopDepth = loopUppers.size(); + llvm::SmallVector ivars; + + for (auto i : llvm::enumerate(llvm::reverse(loopUppers))) { + if (i.index() > 0) { + assert(!loops.empty()); + builder.setInsertionPointToStart(loops.back().getBody()); + } + fir::DoLoopOp loop; + if (innerArg) { + loop = builder.create( + loc, zero, i.value(), one, isUnordered(), + /*finalCount=*/false, mlir::ValueRange{innerArg}); + innerArg = loop.getRegionIterArgs().front(); + if (explicitSpaceIsActive()) + explicitSpace->setInnerArg(0, innerArg); + } else { + loop = builder.create(loc, zero, i.value(), one, + isUnordered(), + /*finalCount=*/false); + } + ivars.push_back(loop.getInductionVar()); + loops.push_back(loop); + } + + if (innerArg) + for (std::remove_const_t i = 0; i + 1 < loopDepth; + ++i) { + builder.setInsertionPointToEnd(loops[i].getBody()); + builder.create(loc, loops[i + 1].getResult(0)); + } + + // Move insertion point to the start of the innermost loop in the nest. + builder.setInsertionPointToStart(loops.back().getBody()); + // Set `afterLoopNest` to just after the entire loop nest. + auto currPt = builder.saveInsertionPoint(); + builder.setInsertionPointAfter(loops[0]); + auto afterLoopNest = builder.saveInsertionPoint(); + builder.restoreInsertionPoint(currPt); + + // Put the implicit loop variables in row to column order to match FIR's + // Ops. (The loops were constructed from outermost column to innermost + // row.) + mlir::Value outerRes = loops[0].getResult(0); + return {IterationSpace(innerArg, outerRes, llvm::reverse(ivars)), + afterLoopNest}; + } + + /// Build the iteration space into which the array expression will be + /// lowered. The resultType is used to create a temporary, if needed. + std::pair + genIterSpace(mlir::Type resultType) { + mlir::Location loc = getLoc(); + llvm::SmallVector shape = genIterationShape(); + if (!destination) { + // Allocate storage for the result if it is not already provided. + destination = createAndLoadSomeArrayTemp(resultType, shape); + } + + // Generate the lazy mask allocation, if one was given. + if (ccPrelude.hasValue()) + ccPrelude.getValue()(shape); + + // Now handle the implicit loops. + mlir::Value inner = explicitSpaceIsActive() + ? explicitSpace->getInnerArgs().front() + : destination.getResult(); + auto [iters, afterLoopNest] = genImplicitLoops(shape, inner); + mlir::Value innerArg = iters.innerArgument(); + + // Generate the mask conditional structure, if there are masks. Unlike the + // explicit masks, which are interleaved, these mask expression appear in + // the innermost loop. + if (implicitSpaceHasMasks()) { + // Recover the cached condition from the mask buffer. + auto genCond = [&](Fortran::lower::FrontEndExpr e, IterSpace iters) { + return implicitSpace->getBoundClosure(e)(iters); + }; + + // Handle the negated conditions in topological order of the WHERE + // clauses. See 10.2.3.2p4 as to why this control structure is produced. + for (llvm::SmallVector maskExprs : + implicitSpace->getMasks()) { + const std::size_t size = maskExprs.size() - 1; + auto genFalseBlock = [&](const auto *e, auto &&cond) { + auto ifOp = builder.create( + loc, mlir::TypeRange{innerArg.getType()}, fir::getBase(cond), + /*withElseRegion=*/true); + builder.create(loc, ifOp.getResult(0)); + builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); + builder.create(loc, innerArg); + builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); + }; + auto genTrueBlock = [&](const auto *e, auto &&cond) { + auto ifOp = builder.create( + loc, mlir::TypeRange{innerArg.getType()}, fir::getBase(cond), + /*withElseRegion=*/true); + builder.create(loc, ifOp.getResult(0)); + builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); + builder.create(loc, innerArg); + builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); + }; + for (std::remove_const_t i = 0; i < size; ++i) + if (const auto *e = maskExprs[i]) + genFalseBlock(e, genCond(e, iters)); + + // The last condition is either non-negated or unconditionally negated. + if (const auto *e = maskExprs[size]) + genTrueBlock(e, genCond(e, iters)); + } + } + + // We're ready to lower the body (an assignment statement) for this context + // of loop nests at this point. + return {iters, afterLoopNest}; + } + + fir::ArrayLoadOp + createAndLoadSomeArrayTemp(mlir::Type type, + llvm::ArrayRef shape) { + if (ccLoadDest.hasValue()) + return ccLoadDest.getValue()(shape); + auto seqTy = type.dyn_cast(); + assert(seqTy && "must be an array"); + mlir::Location loc = getLoc(); + // TODO: Need to thread the length parameters here. For character, they may + // differ from the operands length (e.g concatenation). So the array loads + // type parameters are not enough. + if (auto charTy = seqTy.getEleTy().dyn_cast()) + if (charTy.hasDynamicLen()) + TODO(loc, "character array expression temp with dynamic length"); + if (auto recTy = seqTy.getEleTy().dyn_cast()) + if (recTy.getNumLenParams() > 0) + TODO(loc, "derived type array expression temp with length parameters"); + mlir::Value temp = seqTy.hasConstantShape() + ? builder.create(loc, type) + : builder.create( + loc, type, ".array.expr", llvm::None, shape); + fir::FirOpBuilder *bldr = &converter.getFirOpBuilder(); + stmtCtx.attachCleanup( + [bldr, loc, temp]() { bldr->create(loc, temp); }); + mlir::Value shapeOp = genShapeOp(shape); + return builder.create(loc, seqTy, temp, shapeOp, + /*slice=*/mlir::Value{}, + llvm::None); + } + + static fir::ShapeOp genShapeOp(mlir::Location loc, fir::FirOpBuilder &builder, + llvm::ArrayRef shape) { + mlir::IndexType idxTy = builder.getIndexType(); + llvm::SmallVector idxShape; + for (auto s : shape) + idxShape.push_back(builder.createConvert(loc, idxTy, s)); + auto shapeTy = fir::ShapeType::get(builder.getContext(), idxShape.size()); + return builder.create(loc, shapeTy, idxShape); + } + + fir::ShapeOp genShapeOp(llvm::ArrayRef shape) { + return genShapeOp(getLoc(), builder, shape); + } + + //===--------------------------------------------------------------------===// + // Expression traversal and lowering. + //===--------------------------------------------------------------------===// + + /// Lower the expression, \p x, in a scalar context. + template + ExtValue asScalar(const A &x) { + return ScalarExprLowering{getLoc(), converter, symMap, stmtCtx}.genval(x); + } + + /// Lower the expression in a scalar context to a memory reference. + template + ExtValue asScalarRef(const A &x) { + return ScalarExprLowering{getLoc(), converter, symMap, stmtCtx}.gen(x); + } + + // An expression with non-zero rank is an array expression. + template + bool isArray(const A &x) const { + return x.Rank() != 0; + } + + /// If there were temporaries created for this element evaluation, finalize + /// and deallocate the resources now. This should be done just prior the the + /// fir::ResultOp at the end of the innermost loop. + void finalizeElementCtx() { + if (elementCtx) { + stmtCtx.finalize(/*popScope=*/true); + elementCtx = false; + } + } + + template + CC genScalarAndForwardValue(const A &x) { + ExtValue result = asScalar(x); + return [=](IterSpace) { return result; }; + } + + template >> + CC genarr(const A &x) { + return genScalarAndForwardValue(x); + } + + template + CC genarr(const Fortran::evaluate::Expr &x) { + LLVM_DEBUG(Fortran::lower::DumpEvaluateExpr::dump(llvm::dbgs(), x)); + if (isArray(x) || explicitSpaceIsActive() || + isElementalProcWithArrayArgs(x)) + return std::visit([&](const auto &e) { return genarr(e); }, x.u); + return genScalarAndForwardValue(x); + } + + template + CC genarr(const Fortran::evaluate::Convert, + TC2> &x) { + TODO(getLoc(), ""); + } + + template + CC genarr(const Fortran::evaluate::ComplexComponent &x) { + TODO(getLoc(), ""); + } + + template + CC genarr(const Fortran::evaluate::Parentheses &x) { + TODO(getLoc(), ""); + } + + template + CC genarr(const Fortran::evaluate::Negate> &x) { + TODO(getLoc(), ""); + } + + template + CC genarr(const Fortran::evaluate::Negate> &x) { + TODO(getLoc(), ""); + } + template + CC genarr(const Fortran::evaluate::Negate> &x) { + TODO(getLoc(), ""); + } + +#undef GENBIN +#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp) \ + template \ + CC genarr(const Fortran::evaluate::GenBinEvOp> &x) { \ + TODO(getLoc(), "genarr Binary"); \ + } + + GENBIN(Add, Integer, mlir::arith::AddIOp) + GENBIN(Add, Real, mlir::arith::AddFOp) + GENBIN(Add, Complex, fir::AddcOp) + GENBIN(Subtract, Integer, mlir::arith::SubIOp) + GENBIN(Subtract, Real, mlir::arith::SubFOp) + GENBIN(Subtract, Complex, fir::SubcOp) + GENBIN(Multiply, Integer, mlir::arith::MulIOp) + GENBIN(Multiply, Real, mlir::arith::MulFOp) + GENBIN(Multiply, Complex, fir::MulcOp) + GENBIN(Divide, Integer, mlir::arith::DivSIOp) + GENBIN(Divide, Real, mlir::arith::DivFOp) + GENBIN(Divide, Complex, fir::DivcOp) + + template + CC genarr( + const Fortran::evaluate::Power> &x) { + TODO(getLoc(), "genarr "); + } + template + CC genarr( + const Fortran::evaluate::Extremum> &x) { + TODO(getLoc(), "genarr "); + } + template + CC genarr( + const Fortran::evaluate::RealToIntPower> + &x) { + TODO(getLoc(), "genarr "); + } + template + CC genarr(const Fortran::evaluate::ComplexConstructor &x) { + TODO(getLoc(), "genarr "); + } + + template + CC genarr(const Fortran::evaluate::Concat &x) { + TODO(getLoc(), "genarr "); + } + + template + CC genarr(const Fortran::evaluate::SetLength &x) { + TODO(getLoc(), "genarr "); + } + + template + CC genarr(const Fortran::evaluate::Constant &x) { + TODO(getLoc(), "genarr "); + } + + CC genarr(const Fortran::semantics::SymbolRef &sym, + ComponentPath &components) { + return genarr(sym.get(), components); + } + + ExtValue abstractArrayExtValue(mlir::Value val, mlir::Value len = {}) { + return convertToArrayBoxValue(getLoc(), builder, val, len); + } + + CC genarr(const ExtValue &extMemref) { + ComponentPath dummy(/*isImplicit=*/true); + return genarr(extMemref, dummy); + } + + template + CC genarr(const Fortran::evaluate::ArrayConstructor &x) { + TODO(getLoc(), "genarr ArrayConstructor"); + } + + CC genarr(const Fortran::evaluate::ImpliedDoIndex &) { + TODO(getLoc(), "genarr ImpliedDoIndex"); + } + + CC genarr(const Fortran::evaluate::TypeParamInquiry &x) { + TODO(getLoc(), "genarr TypeParamInquiry"); + } + + CC genarr(const Fortran::evaluate::DescriptorInquiry &x) { + TODO(getLoc(), "genarr DescriptorInquiry"); + } + + CC genarr(const Fortran::evaluate::StructureConstructor &x) { + TODO(getLoc(), "genarr StructureConstructor"); + } + + template + CC genarr(const Fortran::evaluate::Not &x) { + TODO(getLoc(), "genarr Not"); + } + + template + CC genarr(const Fortran::evaluate::LogicalOperation &x) { + TODO(getLoc(), "genarr LogicalOperation"); + } + + template + CC genarr(const Fortran::evaluate::Relational> &x) { + TODO(getLoc(), "genarr Relational Integer"); + } + template + CC genarr(const Fortran::evaluate::Relational> &x) { + TODO(getLoc(), "genarr Relational Character"); + } + template + CC genarr(const Fortran::evaluate::Relational> &x) { + TODO(getLoc(), "genarr Relational Real"); + } + template + CC genarr(const Fortran::evaluate::Relational> &x) { + TODO(getLoc(), "genarr Relational Complex"); + } + CC genarr( + const Fortran::evaluate::Relational &r) { + TODO(getLoc(), "genarr Relational SomeType"); + } + + template + CC genarr(const Fortran::evaluate::Designator &des) { + ComponentPath components(des.Rank() > 0); + return std::visit([&](const auto &x) { return genarr(x, components); }, + des.u); + } + + template + CC genarr(const Fortran::evaluate::FunctionRef &funRef) { + TODO(getLoc(), "genarr FunctionRef"); + } + + template + CC genImplicitArrayAccess(const A &x, ComponentPath &components) { + components.reversePath.push_back(ImplicitSubscripts{}); + ExtValue exv = asScalarRef(x); + // lowerPath(exv, components); + auto lambda = genarr(exv, components); + return [=](IterSpace iters) { return lambda(components.pc(iters)); }; + } + CC genImplicitArrayAccess(const Fortran::evaluate::NamedEntity &x, + ComponentPath &components) { + if (x.IsSymbol()) + return genImplicitArrayAccess(x.GetFirstSymbol(), components); + return genImplicitArrayAccess(x.GetComponent(), components); + } + + template + CC genAsScalar(const A &x) { + mlir::Location loc = getLoc(); + if (isProjectedCopyInCopyOut()) { + return [=, &x, builder = &converter.getFirOpBuilder()]( + IterSpace iters) -> ExtValue { + ExtValue exv = asScalarRef(x); + mlir::Value val = fir::getBase(exv); + mlir::Type eleTy = fir::unwrapRefType(val.getType()); + if (isAdjustedArrayElementType(eleTy)) { + if (fir::isa_char(eleTy)) { + TODO(getLoc(), "assignment of character type"); + } else if (fir::isa_derived(eleTy)) { + TODO(loc, "assignment of derived type"); + } else { + fir::emitFatalError(loc, "array type not expected in scalar"); + } + } else { + builder->create(loc, iters.getElement(), val); + } + return exv; + }; + } + return [=, &x](IterSpace) { return asScalar(x); }; + } + + CC genarr(const Fortran::semantics::Symbol &x, ComponentPath &components) { + if (explicitSpaceIsActive()) { + TODO(getLoc(), "genarr Symbol explicitSpace"); + } else { + return genImplicitArrayAccess(x, components); + } + } + + CC genarr(const Fortran::evaluate::Component &x, ComponentPath &components) { + TODO(getLoc(), "genarr Component"); + } + + CC genarr(const Fortran::evaluate::ArrayRef &x, ComponentPath &components) { + TODO(getLoc(), "genar ArrayRef"); + } + + CC genarr(const Fortran::evaluate::CoarrayRef &x, ComponentPath &components) { + TODO(getLoc(), "coarray reference"); + } + + CC genarr(const Fortran::evaluate::NamedEntity &x, + ComponentPath &components) { + return x.IsSymbol() ? genarr(x.GetFirstSymbol(), components) + : genarr(x.GetComponent(), components); + } + + CC genarr(const Fortran::evaluate::DataRef &x, ComponentPath &components) { + return std::visit([&](const auto &v) { return genarr(v, components); }, + x.u); + } + + CC genarr(const Fortran::evaluate::ComplexPart &x, + ComponentPath &components) { + TODO(getLoc(), "genarr ComplexPart"); + } + + CC genarr(const Fortran::evaluate::StaticDataObject::Pointer &, + ComponentPath &components) { + TODO(getLoc(), "genarr StaticDataObject::Pointer"); + } + + /// Substrings (see 9.4.1) + CC genarr(const Fortran::evaluate::Substring &x, ComponentPath &components) { + TODO(getLoc(), "genarr Substring"); + } + + /// Base case of generating an array reference, + CC genarr(const ExtValue &extMemref, ComponentPath &components) { + mlir::Location loc = getLoc(); + mlir::Value memref = fir::getBase(extMemref); + mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(memref.getType()); + assert(arrTy.isa() && "memory ref must be an array"); + mlir::Value shape = builder.createShape(loc, extMemref); + mlir::Value slice; + if (components.isSlice()) { + TODO(loc, "genarr with Slices"); + } + arrayOperands.push_back(ArrayOperand{memref, shape, slice}); + if (destShape.empty()) + destShape = getShape(arrayOperands.back()); + if (isBoxValue()) { + TODO(loc, "genarr BoxValue"); + } + if (isReferentiallyOpaque()) { + TODO(loc, "genarr isReferentiallyOpaque"); + } + auto arrLoad = builder.create( + loc, arrTy, memref, shape, slice, fir::getTypeParams(extMemref)); + mlir::Value arrLd = arrLoad.getResult(); + if (isProjectedCopyInCopyOut()) { + // Semantics are projected copy-in copy-out. + // The backing store of the destination of an array expression may be + // partially modified. These updates are recorded in FIR by forwarding a + // continuation that generates an `array_update` Op. The destination is + // always loaded at the beginning of the statement and merged at the + // end. + destination = arrLoad; + auto lambda = ccStoreToDest.hasValue() + ? ccStoreToDest.getValue() + : defaultStoreToDestination(components.substring); + return [=](IterSpace iters) -> ExtValue { return lambda(iters); }; + } + if (isCustomCopyInCopyOut()) { + TODO(loc, "isCustomCopyInCopyOut"); + } + if (isCopyInCopyOut()) { + // Semantics are copy-in copy-out. + // The continuation simply forwards the result of the `array_load` Op, + // which is the value of the array as it was when loaded. All data + // references with rank > 0 in an array expression typically have + // copy-in copy-out semantics. + return [=](IterSpace) -> ExtValue { return arrLd; }; + } + mlir::Operation::operand_range arrLdTypeParams = arrLoad.getTypeparams(); + if (isValueAttribute()) { + // Semantics are value attribute. + // Here the continuation will `array_fetch` a value from an array and + // then store that value in a temporary. One can thus imitate pass by + // value even when the call is pass by reference. + return [=](IterSpace iters) -> ExtValue { + mlir::Value base; + mlir::Type eleTy = fir::applyPathToType(arrTy, iters.iterVec()); + if (isAdjustedArrayElementType(eleTy)) { + mlir::Type eleRefTy = builder.getRefType(eleTy); + base = builder.create( + loc, eleRefTy, arrLd, iters.iterVec(), arrLdTypeParams); + } else { + base = builder.create( + loc, eleTy, arrLd, iters.iterVec(), arrLdTypeParams); + } + mlir::Value temp = builder.createTemporary( + loc, base.getType(), + llvm::ArrayRef{ + Fortran::lower::getAdaptToByRefAttr(builder)}); + builder.create(loc, base, temp); + return fir::factory::arraySectionElementToExtendedValue( + builder, loc, extMemref, temp, slice); + }; + } + // In the default case, the array reference forwards an `array_fetch` or + // `array_access` Op in the continuation. + return [=](IterSpace iters) -> ExtValue { + mlir::Type eleTy = fir::applyPathToType(arrTy, iters.iterVec()); + if (isAdjustedArrayElementType(eleTy)) { + mlir::Type eleRefTy = builder.getRefType(eleTy); + mlir::Value arrayOp = builder.create( + loc, eleRefTy, arrLd, iters.iterVec(), arrLdTypeParams); + if (auto charTy = eleTy.dyn_cast()) { + llvm::SmallVector substringBounds; + populateBounds(substringBounds, components.substring); + if (!substringBounds.empty()) { + // mlir::Value dstLen = fir::factory::genLenOfCharacter( + // builder, loc, arrLoad, iters.iterVec(), substringBounds); + // fir::CharBoxValue dstChar(arrayOp, dstLen); + // return fir::factory::CharacterExprHelper{builder, loc} + // .createSubstring(dstChar, substringBounds); + } + } + return fir::factory::arraySectionElementToExtendedValue( + builder, loc, extMemref, arrayOp, slice); + } + auto arrFetch = builder.create( + loc, eleTy, arrLd, iters.iterVec(), arrLdTypeParams); + return fir::factory::arraySectionElementToExtendedValue( + builder, loc, extMemref, arrFetch, slice); + }; + } + + /// Reduce the rank of a array to be boxed based on the slice's operands. + static mlir::Type reduceRank(mlir::Type arrTy, mlir::Value slice) { + if (slice) { + auto slOp = mlir::dyn_cast(slice.getDefiningOp()); + assert(slOp && "expected slice op"); + auto seqTy = arrTy.dyn_cast(); + assert(seqTy && "expected array type"); + mlir::Operation::operand_range triples = slOp.getTriples(); + fir::SequenceType::Shape shape; + // reduce the rank for each invariant dimension + for (unsigned i = 1, end = triples.size(); i < end; i += 3) + if (!mlir::isa_and_nonnull(triples[i].getDefiningOp())) + shape.push_back(fir::SequenceType::getUnknownExtent()); + return fir::SequenceType::get(shape, seqTy.getEleTy()); + } + // not sliced, so no change in rank + return arrTy; + } + +private: + void determineShapeOfDest(const fir::ExtendedValue &lhs) { + destShape = fir::factory::getExtents(builder, getLoc(), lhs); + } + + void determineShapeOfDest(const Fortran::lower::SomeExpr &lhs) { + if (!destShape.empty()) + return; + // if (explicitSpaceIsActive() && determineShapeWithSlice(lhs)) + // return; + mlir::Type idxTy = builder.getIndexType(); + mlir::Location loc = getLoc(); + if (std::optional constantShape = + Fortran::evaluate::GetConstantExtents(converter.getFoldingContext(), + lhs)) + for (Fortran::common::ConstantSubscript extent : *constantShape) + destShape.push_back(builder.createIntegerConstant(loc, idxTy, extent)); + } + + ExtValue lowerArrayExpression(const Fortran::lower::SomeExpr &exp) { + mlir::Type resTy = converter.genType(exp); + return std::visit( + [&](const auto &e) { return lowerArrayExpression(genarr(e), resTy); }, + exp.u); + } + ExtValue lowerArrayExpression(const ExtValue &exv) { + assert(!explicitSpace); + mlir::Type resTy = fir::unwrapPassByRefType(fir::getBase(exv).getType()); + return lowerArrayExpression(genarr(exv), resTy); + } + + void populateBounds(llvm::SmallVectorImpl &bounds, + const Fortran::evaluate::Substring *substring) { + if (!substring) + return; + bounds.push_back(fir::getBase(asScalar(substring->lower()))); + if (auto upper = substring->upper()) + bounds.push_back(fir::getBase(asScalar(*upper))); + } + + /// Default store to destination implementation. + /// This implements the default case, which is to assign the value in + /// `iters.element` into the destination array, `iters.innerArgument`. Handles + /// by value and by reference assignment. + CC defaultStoreToDestination(const Fortran::evaluate::Substring *substring) { + return [=](IterSpace iterSpace) -> ExtValue { + mlir::Location loc = getLoc(); + mlir::Value innerArg = iterSpace.innerArgument(); + fir::ExtendedValue exv = iterSpace.elementExv(); + mlir::Type arrTy = innerArg.getType(); + mlir::Type eleTy = fir::applyPathToType(arrTy, iterSpace.iterVec()); + if (isAdjustedArrayElementType(eleTy)) { + TODO(loc, "isAdjustedArrayElementType"); + } + // By value semantics. The element is being assigned by value. + mlir::Value ele = builder.createConvert(loc, eleTy, fir::getBase(exv)); + auto update = builder.create( + loc, arrTy, innerArg, ele, iterSpace.iterVec(), + destination.getTypeparams()); + return abstractArrayExtValue(update); + }; + } + + /// For an elemental array expression. + /// 1. Lower the scalars and array loads. + /// 2. Create the iteration space. + /// 3. Create the element-by-element computation in the loop. + /// 4. Return the resulting array value. + /// If no destination was set in the array context, a temporary of + /// \p resultTy will be created to hold the evaluated expression. + /// Otherwise, \p resultTy is ignored and the expression is evaluated + /// in the destination. \p f is a continuation built from an + /// evaluate::Expr or an ExtendedValue. + ExtValue lowerArrayExpression(CC f, mlir::Type resultTy) { + mlir::Location loc = getLoc(); + auto [iterSpace, insPt] = genIterSpace(resultTy); + auto exv = f(iterSpace); + iterSpace.setElement(std::move(exv)); + auto lambda = ccStoreToDest.hasValue() + ? ccStoreToDest.getValue() + : defaultStoreToDestination(/*substring=*/nullptr); + mlir::Value updVal = fir::getBase(lambda(iterSpace)); + finalizeElementCtx(); + builder.create(loc, updVal); + builder.restoreInsertionPoint(insPt); + return abstractArrayExtValue(iterSpace.outerResult()); + } + + /// Get the shape from an ArrayOperand. The shape of the array is adjusted if + /// the array was sliced. + llvm::SmallVector getShape(ArrayOperand array) { + // if (array.slice) + // return computeSliceShape(array.slice); + if (array.memref.getType().isa()) + return fir::factory::readExtents(builder, getLoc(), + fir::BoxValue{array.memref}); + std::vector> extents = + fir::factory::getExtents(array.shape); + return {extents.begin(), extents.end()}; + } + + /// Get the shape from an ArrayLoad. + llvm::SmallVector getShape(fir::ArrayLoadOp arrayLoad) { + return getShape(ArrayOperand{arrayLoad.getMemref(), arrayLoad.getShape(), + arrayLoad.getSlice()}); + } + + /// Returns the first array operand that may not be absent. If all + /// array operands may be absent, return the first one. + const ArrayOperand &getInducingShapeArrayOperand() const { + assert(!arrayOperands.empty()); + for (const ArrayOperand &op : arrayOperands) + if (!op.mayBeAbsent) + return op; + // If all arrays operand appears in optional position, then none of them + // is allowed to be absent as per 15.5.2.12 point 3. (6). Just pick the + // first operands. + // TODO: There is an opportunity to add a runtime check here that + // this array is present as required. + return arrayOperands[0]; + } + + /// Generate the shape of the iteration space over the array expression. The + /// iteration space may be implicit, explicit, or both. If it is implied it is + /// based on the destination and operand array loads, or an optional + /// Fortran::evaluate::Shape from the front end. If the shape is explicit, + /// this returns any implicit shape component, if it exists. + llvm::SmallVector genIterationShape() { + // Use the precomputed destination shape. + if (!destShape.empty()) + return destShape; + // Otherwise, use the destination's shape. + if (destination) + return getShape(destination); + // Otherwise, use the first ArrayLoad operand shape. + if (!arrayOperands.empty()) + return getShape(getInducingShapeArrayOperand()); + fir::emitFatalError(getLoc(), + "failed to compute the array expression shape"); + } + + bool explicitSpaceIsActive() const { + return explicitSpace && explicitSpace->isActive(); + } + + bool implicitSpaceHasMasks() const { + return implicitSpace && !implicitSpace->empty(); + } + + explicit ArrayExprLowering(Fortran::lower::AbstractConverter &converter, + Fortran::lower::StatementContext &stmtCtx, + Fortran::lower::SymMap &symMap) + : converter{converter}, builder{converter.getFirOpBuilder()}, + stmtCtx{stmtCtx}, symMap{symMap} {} + + explicit ArrayExprLowering(Fortran::lower::AbstractConverter &converter, + Fortran::lower::StatementContext &stmtCtx, + Fortran::lower::SymMap &symMap, + ConstituentSemantics sem) + : converter{converter}, builder{converter.getFirOpBuilder()}, + stmtCtx{stmtCtx}, symMap{symMap}, semant{sem} {} + + explicit ArrayExprLowering(Fortran::lower::AbstractConverter &converter, + Fortran::lower::StatementContext &stmtCtx, + Fortran::lower::SymMap &symMap, + ConstituentSemantics sem, + Fortran::lower::ExplicitIterSpace *expSpace, + Fortran::lower::ImplicitIterSpace *impSpace) + : converter{converter}, builder{converter.getFirOpBuilder()}, + stmtCtx{stmtCtx}, symMap{symMap}, + explicitSpace(expSpace->isActive() ? expSpace : nullptr), + implicitSpace(impSpace->empty() ? nullptr : impSpace), semant{sem} { + // Generate any mask expressions, as necessary. This is the compute step + // that creates the effective masks. See 10.2.3.2 in particular. + // genMasks(); + } + + mlir::Location getLoc() { return converter.getCurrentLocation(); } + + /// Array appears in a lhs context such that it is assigned after the rhs is + /// fully evaluated. + inline bool isCopyInCopyOut() { + return semant == ConstituentSemantics::CopyInCopyOut; + } + + /// Array appears in a lhs (or temp) context such that a projected, + /// discontiguous subspace of the array is assigned after the rhs is fully + /// evaluated. That is, the rhs array value is merged into a section of the + /// lhs array. + inline bool isProjectedCopyInCopyOut() { + return semant == ConstituentSemantics::ProjectedCopyInCopyOut; + } + + inline bool isCustomCopyInCopyOut() { + return semant == ConstituentSemantics::CustomCopyInCopyOut; + } + + /// Array appears in a context where it must be boxed. + inline bool isBoxValue() { return semant == ConstituentSemantics::BoxValue; } + + /// Array appears in a context where differences in the memory reference can + /// be observable in the computational results. For example, an array + /// element is passed to an impure procedure. + inline bool isReferentiallyOpaque() { + return semant == ConstituentSemantics::RefOpaque; + } + + /// Array appears in a context where it is passed as a VALUE argument. + inline bool isValueAttribute() { + return semant == ConstituentSemantics::ByValueArg; + } + + /// Can the loops over the expression be unordered? + inline bool isUnordered() const { return unordered; } + + void setUnordered(bool b) { unordered = b; } + + Fortran::lower::AbstractConverter &converter; + fir::FirOpBuilder &builder; + Fortran::lower::StatementContext &stmtCtx; + bool elementCtx = false; + Fortran::lower::SymMap &symMap; + /// The continuation to generate code to update the destination. + llvm::Optional ccStoreToDest; + llvm::Optional)>> ccPrelude; + llvm::Optional)>> + ccLoadDest; + /// The destination is the loaded array into which the results will be + /// merged. + fir::ArrayLoadOp destination; + /// The shape of the destination. + llvm::SmallVector destShape; + /// List of arrays in the expression that have been loaded. + llvm::SmallVector arrayOperands; + /// If there is a user-defined iteration space, explicitShape will hold the + /// information from the front end. + Fortran::lower::ExplicitIterSpace *explicitSpace = nullptr; + Fortran::lower::ImplicitIterSpace *implicitSpace = nullptr; + ConstituentSemantics semant = ConstituentSemantics::RefTransparent; + // Can the array expression be evaluated in any order? + // Will be set to false if any of the expression parts prevent this. + bool unordered = true; +}; +} // namespace + fir::ExtendedValue Fortran::lower::createSomeExtendedExpression( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, @@ -1314,3 +2582,36 @@ loc, converter, toEvExpr(call), symMap, stmtCtx); return fir::getBase(res); } + +void Fortran::lower::createSomeArrayAssignment( + Fortran::lower::AbstractConverter &converter, + const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs, + Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { + LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "onto array: ") << '\n'; + rhs.AsFortran(llvm::dbgs() << "assign expression: ") << '\n';); + ArrayExprLowering::lowerArrayAssignment(converter, symMap, stmtCtx, lhs, rhs); +} + +void Fortran::lower::createSomeArrayAssignment( + Fortran::lower::AbstractConverter &converter, const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs, Fortran::lower::SymMap &symMap, + Fortran::lower::StatementContext &stmtCtx) { + LLVM_DEBUG(llvm::dbgs() << "onto array: " << lhs << '\n'; + llvm::dbgs() << "assign expression: " << rhs << '\n';); + ArrayExprLowering::lowerArrayAssignment(converter, symMap, stmtCtx, lhs, rhs); +} + +void Fortran::lower::createAllocatableArrayAssignment( + Fortran::lower::AbstractConverter &converter, + const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs, + Fortran::lower::ExplicitIterSpace &explicitSpace, + Fortran::lower::ImplicitIterSpace &implicitSpace, + Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { + LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "defining array: ") << '\n'; + rhs.AsFortran(llvm::dbgs() << "assign expression: ") + << " given the explicit iteration space:\n" + << explicitSpace << "\n and implied mask conditions:\n" + << implicitSpace << '\n';); + ArrayExprLowering::lowerAllocatableArrayAssignment( + converter, symMap, stmtCtx, lhs, rhs, explicitSpace, implicitSpace); +} diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -301,13 +301,13 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::ScalarStaticChar &x) { - TODO(loc, "mapSymbolAttributes ScalarStaticChar"); + TODO(loc, "ScalarStaticChar variable lowering"); }, //===--------------------------------------------------------------===// [&](const Fortran::lower::details::ScalarDynamicChar &x) { - TODO(loc, "mapSymbolAttributes ScalarDynamicChar"); + TODO(loc, "ScalarDynamicChar variable lowering"); }, //===--------------------------------------------------------------===// @@ -346,31 +346,31 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::DynamicArray &x) { - TODO(loc, "mapSymbolAttributes DynamicArray"); + TODO(loc, "DynamicArray variable lowering"); }, //===--------------------------------------------------------------===// [&](const Fortran::lower::details::StaticArrayStaticChar &x) { - TODO(loc, "mapSymbolAttributes StaticArrayStaticChar"); + TODO(loc, "StaticArrayStaticChar variable lowering"); }, //===--------------------------------------------------------------===// [&](const Fortran::lower::details::StaticArrayDynamicChar &x) { - TODO(loc, "mapSymbolAttributes StaticArrayDynamicChar"); + TODO(loc, "StaticArrayDynamicChar variable lowering"); }, //===--------------------------------------------------------------===// [&](const Fortran::lower::details::DynamicArrayStaticChar &x) { - TODO(loc, "mapSymbolAttributes DynamicArrayStaticChar"); + TODO(loc, "DynamicArrayStaticChar variable lowering"); }, //===--------------------------------------------------------------===// [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) { - TODO(loc, "mapSymbolAttributes DynamicArrayDynamicChar"); + TODO(loc, "DynamicArrayDynamicChar variable lowering"); }, //===--------------------------------------------------------------===// diff --git a/flang/lib/Lower/DumpEvaluateExpr.cpp b/flang/lib/Lower/DumpEvaluateExpr.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/DumpEvaluateExpr.cpp @@ -0,0 +1,272 @@ +//===-- Lower/DumpEvaluateExpr.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/DumpEvaluateExpr.h" +#include + +static constexpr char whiteSpacePadding[] = + ">> "; +static constexpr auto whiteSize = sizeof(whiteSpacePadding) - 1; + +inline const char *Fortran::lower::DumpEvaluateExpr::getIndentString() const { + auto count = (level * 2 >= whiteSize) ? whiteSize : level * 2; + return whiteSpacePadding + whiteSize - count; +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::CoarrayRef &x) { + indent("coarray ref"); + show(x.base()); + show(x.subscript()); + show(x.cosubscript()); + show(x.stat()); + show(x.team()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::BOZLiteralConstant &) { + print("BOZ literal constant"); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::NullPointer &) { + print("null pointer"); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::semantics::Symbol &symbol) { + const auto &ultimate{symbol.GetUltimate()}; + print("symbol: "s + std::string(toStringRef(symbol.name()))); + if (const auto *assoc = + ultimate.detailsIf()) { + indent("assoc details"); + show(assoc->expr()); + outdent(); + } +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::StaticDataObject &) { + print("static data object"); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::ImpliedDoIndex &) { + print("implied do index"); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::BaseObject &x) { + indent("base object"); + show(x.u); + outdent(); +} +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::Component &x) { + indent("component"); + show(x.base()); + show(x.GetLastSymbol()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::NamedEntity &x) { + indent("named entity"); + if (const auto *component = x.UnwrapComponent()) + show(*component); + else + show(x.GetFirstSymbol()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::TypeParamInquiry &x) { + indent("type inquiry"); + show(x.base()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::Triplet &x) { + indent("triplet"); + show(x.lower()); + show(x.upper()); + show(x.stride()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::Subscript &x) { + indent("subscript"); + show(x.u); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::ArrayRef &x) { + indent("array ref"); + show(x.base()); + show(x.subscript()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::DataRef &x) { + indent("data ref"); + show(x.u); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::Substring &x) { + indent("substring"); + show(x.parent()); + show(x.lower()); + show(x.upper()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::semantics::ParamValue &x) { + indent("param value"); + show(x.GetExplicit()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::semantics::DerivedTypeSpec::ParameterMapType::value_type + &x) { + show(x.second); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::semantics::DerivedTypeSpec &x) { + indent("derived type spec"); + for (auto &v : x.parameters()) + show(v); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::StructureConstructorValues::value_type &x) { + show(x.second); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::StructureConstructor &x) { + indent("structure constructor"); + show(x.derivedTypeSpec()); + for (auto &v : x) + show(v); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::Relational &x) { + indent("expr some type"); + show(x.u); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::ComplexPart &x) { + indent("complex part"); + show(x.complex()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::ActualArgument &x) { + indent("actual argument"); + if (const auto *symbol = x.GetAssumedTypeDummy()) + show(*symbol); + else + show(x.UnwrapExpr()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::ProcedureDesignator &x) { + indent("procedure designator"); + if (const auto *component = x.GetComponent()) + show(*component); + else if (const auto *symbol = x.GetSymbol()) + show(*symbol); + else + show(DEREF(x.GetSpecificIntrinsic())); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::SpecificIntrinsic &) { + print("specific intrinsic"); +} + +void Fortran::lower::DumpEvaluateExpr::show( + const Fortran::evaluate::DescriptorInquiry &x) { + indent("descriptor inquiry"); + show(x.base()); + outdent(); +} + +void Fortran::lower::DumpEvaluateExpr::print(llvm::Twine twine) { + outs << getIndentString() << twine << '\n'; +} + +void Fortran::lower::DumpEvaluateExpr::indent(llvm::StringRef s) { + print(s + " {"); + level++; +} + +void Fortran::lower::DumpEvaluateExpr::outdent() { + if (level) + level--; + print("}"); +} + +//===----------------------------------------------------------------------===// +// Boilerplate entry points that the debugger can find. +//===----------------------------------------------------------------------===// + +void Fortran::lower::dumpEvExpr(const Fortran::semantics::SomeExpr &x) { + DumpEvaluateExpr::dump(x); +} + +void Fortran::lower::dumpEvExpr( + const Fortran::evaluate::Expr< + Fortran::evaluate::Type> + &x) { + DumpEvaluateExpr::dump(x); +} + +void Fortran::lower::dumpEvExpr( + const Fortran::evaluate::Expr< + Fortran::evaluate::Type> + &x) { + DumpEvaluateExpr::dump(x); +} + +void Fortran::lower::dumpEvExpr(const Fortran::evaluate::ArrayRef &x) { + DumpEvaluateExpr::dump(x); +} + +void Fortran::lower::dumpEvExpr(const Fortran::evaluate::DataRef &x) { + DumpEvaluateExpr::dump(x); +} + +void Fortran::lower::dumpEvExpr(const Fortran::evaluate::Substring &x) { + DumpEvaluateExpr::dump(x); +} + +void Fortran::lower::dumpEvExpr( + const Fortran::evaluate::Designator< + Fortran::evaluate::Type> + &x) { + DumpEvaluateExpr::dump(x); +} diff --git a/flang/lib/Lower/IterationSpace.cpp b/flang/lib/Lower/IterationSpace.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/IterationSpace.cpp @@ -0,0 +1,940 @@ +//===-- IterationSpace.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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/IterationSpace.h" +#include "flang/Evaluate/expression.h" +#include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/Support/Utils.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-lower-iteration-space" + +namespace { +// Fortran::evaluate::Expr are functional values organized like an AST. A +// Fortran::evaluate::Expr is meant to be moved and cloned. Using the front end +// tools can often cause copies and extra wrapper classes to be added to any +// Fortran::evalute::Expr. These values should not be assumed or relied upon to +// have an *object* identity. They are deeply recursive, irregular structures +// built from a large number of classes which do not use inheritance and +// necessitate a large volume of boilerplate code as a result. +// +// Contrastingly, LLVM data structures make ubiquitous assumptions about an +// object's identity via pointers to the object. An object's location in memory +// is thus very often an identifying relation. + +// This class defines a hash computation of a Fortran::evaluate::Expr tree value +// so it can be used with llvm::DenseMap. The Fortran::evaluate::Expr need not +// have the same address. +class HashEvaluateExpr { +public: + // A Se::Symbol is the only part of an Fortran::evaluate::Expr with an + // identity property. + static unsigned getHashValue(const Fortran::semantics::Symbol &x) { + return static_cast(reinterpret_cast(&x)); + } + template + static unsigned getHashValue(const Fortran::common::Indirection &x) { + return getHashValue(x.value()); + } + template + static unsigned getHashValue(const std::optional &x) { + if (x.has_value()) + return getHashValue(x.value()); + return 0u; + } + static unsigned getHashValue(const Fortran::evaluate::Subscript &x) { + return std::visit([&](const auto &v) { return getHashValue(v); }, x.u); + } + static unsigned getHashValue(const Fortran::evaluate::Triplet &x) { + return getHashValue(x.lower()) - getHashValue(x.upper()) * 5u - + getHashValue(x.stride()) * 11u; + } + static unsigned getHashValue(const Fortran::evaluate::Component &x) { + return getHashValue(x.base()) * 83u - getHashValue(x.GetLastSymbol()); + } + static unsigned getHashValue(const Fortran::evaluate::ArrayRef &x) { + unsigned subs = 1u; + for (const Fortran::evaluate::Subscript &v : x.subscript()) + subs -= getHashValue(v); + return getHashValue(x.base()) * 89u - subs; + } + static unsigned getHashValue(const Fortran::evaluate::CoarrayRef &x) { + unsigned subs = 1u; + for (const Fortran::evaluate::Subscript &v : x.subscript()) + subs -= getHashValue(v); + unsigned cosubs = 3u; + for (const Fortran::evaluate::Expr &v : + x.cosubscript()) + cosubs -= getHashValue(v); + unsigned syms = 7u; + for (const Fortran::evaluate::SymbolRef &v : x.base()) + syms += getHashValue(v); + return syms * 97u - subs - cosubs + getHashValue(x.stat()) + 257u + + getHashValue(x.team()); + } + static unsigned getHashValue(const Fortran::evaluate::NamedEntity &x) { + if (x.IsSymbol()) + return getHashValue(x.GetFirstSymbol()) * 11u; + return getHashValue(x.GetComponent()) * 13u; + } + static unsigned getHashValue(const Fortran::evaluate::DataRef &x) { + return std::visit([&](const auto &v) { return getHashValue(v); }, x.u); + } + static unsigned getHashValue(const Fortran::evaluate::ComplexPart &x) { + return getHashValue(x.complex()) - static_cast(x.part()); + } + template + static unsigned getHashValue( + const Fortran::evaluate::Convert, TC2> + &x) { + return getHashValue(x.left()) - (static_cast(TC1) + 2u) - + (static_cast(KIND) + 5u); + } + template + static unsigned + getHashValue(const Fortran::evaluate::ComplexComponent &x) { + return getHashValue(x.left()) - + (static_cast(x.isImaginaryPart) + 1u) * 3u; + } + template + static unsigned getHashValue(const Fortran::evaluate::Parentheses &x) { + return getHashValue(x.left()) * 17u; + } + template + static unsigned getHashValue( + const Fortran::evaluate::Negate> &x) { + return getHashValue(x.left()) - (static_cast(TC) + 5u) - + (static_cast(KIND) + 7u); + } + template + static unsigned getHashValue( + const Fortran::evaluate::Add> &x) { + return (getHashValue(x.left()) + getHashValue(x.right())) * 23u + + static_cast(TC) + static_cast(KIND); + } + template + static unsigned getHashValue( + const Fortran::evaluate::Subtract> &x) { + return (getHashValue(x.left()) - getHashValue(x.right())) * 19u + + static_cast(TC) + static_cast(KIND); + } + template + static unsigned getHashValue( + const Fortran::evaluate::Multiply> &x) { + return (getHashValue(x.left()) + getHashValue(x.right())) * 29u + + static_cast(TC) + static_cast(KIND); + } + template + static unsigned getHashValue( + const Fortran::evaluate::Divide> &x) { + return (getHashValue(x.left()) - getHashValue(x.right())) * 31u + + static_cast(TC) + static_cast(KIND); + } + template + static unsigned getHashValue( + const Fortran::evaluate::Power> &x) { + return (getHashValue(x.left()) - getHashValue(x.right())) * 37u + + static_cast(TC) + static_cast(KIND); + } + template + static unsigned getHashValue( + const Fortran::evaluate::Extremum> &x) { + return (getHashValue(x.left()) + getHashValue(x.right())) * 41u + + static_cast(TC) + static_cast(KIND) + + static_cast(x.ordering) * 7u; + } + template + static unsigned getHashValue( + const Fortran::evaluate::RealToIntPower> + &x) { + return (getHashValue(x.left()) - getHashValue(x.right())) * 43u + + static_cast(TC) + static_cast(KIND); + } + template + static unsigned + getHashValue(const Fortran::evaluate::ComplexConstructor &x) { + return (getHashValue(x.left()) - getHashValue(x.right())) * 47u + + static_cast(KIND); + } + template + static unsigned getHashValue(const Fortran::evaluate::Concat &x) { + return (getHashValue(x.left()) - getHashValue(x.right())) * 53u + + static_cast(KIND); + } + template + static unsigned getHashValue(const Fortran::evaluate::SetLength &x) { + return (getHashValue(x.left()) - getHashValue(x.right())) * 59u + + static_cast(KIND); + } + static unsigned getHashValue(const Fortran::semantics::SymbolRef &sym) { + return getHashValue(sym.get()); + } + static unsigned getHashValue(const Fortran::evaluate::Substring &x) { + return 61u * std::visit([&](const auto &p) { return getHashValue(p); }, + x.parent()) - + getHashValue(x.lower()) - (getHashValue(x.lower()) + 1u); + } + static unsigned + getHashValue(const Fortran::evaluate::StaticDataObject::Pointer &x) { + return llvm::hash_value(x->name()); + } + static unsigned getHashValue(const Fortran::evaluate::SpecificIntrinsic &x) { + return llvm::hash_value(x.name); + } + template + static unsigned getHashValue(const Fortran::evaluate::Constant &x) { + // FIXME: Should hash the content. + return 103u; + } + static unsigned getHashValue(const Fortran::evaluate::ActualArgument &x) { + if (const Fortran::evaluate::Symbol *sym = x.GetAssumedTypeDummy()) + return getHashValue(*sym); + return getHashValue(*x.UnwrapExpr()); + } + static unsigned + getHashValue(const Fortran::evaluate::ProcedureDesignator &x) { + return std::visit([&](const auto &v) { return getHashValue(v); }, x.u); + } + static unsigned getHashValue(const Fortran::evaluate::ProcedureRef &x) { + unsigned args = 13u; + for (const std::optional &v : + x.arguments()) + args -= getHashValue(v); + return getHashValue(x.proc()) * 101u - args; + } + template + static unsigned + getHashValue(const Fortran::evaluate::ArrayConstructor &x) { + // FIXME: hash the contents. + return 127u; + } + static unsigned getHashValue(const Fortran::evaluate::ImpliedDoIndex &x) { + return llvm::hash_value(toStringRef(x.name).str()) * 131u; + } + static unsigned getHashValue(const Fortran::evaluate::TypeParamInquiry &x) { + return getHashValue(x.base()) * 137u - getHashValue(x.parameter()) * 3u; + } + static unsigned getHashValue(const Fortran::evaluate::DescriptorInquiry &x) { + return getHashValue(x.base()) * 139u - + static_cast(x.field()) * 13u + + static_cast(x.dimension()); + } + static unsigned + getHashValue(const Fortran::evaluate::StructureConstructor &x) { + // FIXME: hash the contents. + return 149u; + } + template + static unsigned getHashValue(const Fortran::evaluate::Not &x) { + return getHashValue(x.left()) * 61u + static_cast(KIND); + } + template + static unsigned + getHashValue(const Fortran::evaluate::LogicalOperation &x) { + unsigned result = getHashValue(x.left()) + getHashValue(x.right()); + return result * 67u + static_cast(x.logicalOperator) * 5u; + } + template + static unsigned getHashValue( + const Fortran::evaluate::Relational> + &x) { + return (getHashValue(x.left()) + getHashValue(x.right())) * 71u + + static_cast(TC) + static_cast(KIND) + + static_cast(x.opr) * 11u; + } + template + static unsigned getHashValue(const Fortran::evaluate::Expr &x) { + return std::visit([&](const auto &v) { return getHashValue(v); }, x.u); + } + static unsigned getHashValue( + const Fortran::evaluate::Relational &x) { + return std::visit([&](const auto &v) { return getHashValue(v); }, x.u); + } + template + static unsigned getHashValue(const Fortran::evaluate::Designator &x) { + return std::visit([&](const auto &v) { return getHashValue(v); }, x.u); + } + template + static unsigned + getHashValue(const Fortran::evaluate::value::Integer &x) { + return static_cast(x.ToSInt()); + } + static unsigned getHashValue(const Fortran::evaluate::NullPointer &x) { + return ~179u; + } +}; +} // namespace + +unsigned Fortran::lower::getHashValue( + const Fortran::lower::ExplicitIterSpace::ArrayBases &x) { + return std::visit( + [&](const auto *p) { return HashEvaluateExpr::getHashValue(*p); }, x); +} + +unsigned Fortran::lower::getHashValue(Fortran::lower::FrontEndExpr x) { + return HashEvaluateExpr::getHashValue(*x); +} + +namespace { +// Define the is equals test for using Fortran::evaluate::Expr values with +// llvm::DenseMap. +class IsEqualEvaluateExpr { +public: + // A Se::Symbol is the only part of an Fortran::evaluate::Expr with an + // identity property. + static bool isEqual(const Fortran::semantics::Symbol &x, + const Fortran::semantics::Symbol &y) { + return isEqual(&x, &y); + } + static bool isEqual(const Fortran::semantics::Symbol *x, + const Fortran::semantics::Symbol *y) { + return x == y; + } + template + static bool isEqual(const Fortran::common::Indirection &x, + const Fortran::common::Indirection &y) { + return isEqual(x.value(), y.value()); + } + template + static bool isEqual(const std::optional &x, const std::optional &y) { + if (x.has_value() && y.has_value()) + return isEqual(x.value(), y.value()); + return !x.has_value() && !y.has_value(); + } + template + static bool isEqual(const std::vector &x, const std::vector &y) { + if (x.size() != y.size()) + return false; + const std::size_t size = x.size(); + for (std::remove_const_t i = 0; i < size; ++i) + if (!isEqual(x[i], y[i])) + return false; + return true; + } + static bool isEqual(const Fortran::evaluate::Subscript &x, + const Fortran::evaluate::Subscript &y) { + return std::visit( + [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u); + } + static bool isEqual(const Fortran::evaluate::Triplet &x, + const Fortran::evaluate::Triplet &y) { + return isEqual(x.lower(), y.lower()) && isEqual(x.upper(), y.upper()) && + isEqual(x.stride(), y.stride()); + } + static bool isEqual(const Fortran::evaluate::Component &x, + const Fortran::evaluate::Component &y) { + return isEqual(x.base(), y.base()) && + isEqual(x.GetLastSymbol(), y.GetLastSymbol()); + } + static bool isEqual(const Fortran::evaluate::ArrayRef &x, + const Fortran::evaluate::ArrayRef &y) { + return isEqual(x.base(), y.base()) && isEqual(x.subscript(), y.subscript()); + } + static bool isEqual(const Fortran::evaluate::CoarrayRef &x, + const Fortran::evaluate::CoarrayRef &y) { + return isEqual(x.base(), y.base()) && + isEqual(x.subscript(), y.subscript()) && + isEqual(x.cosubscript(), y.cosubscript()) && + isEqual(x.stat(), y.stat()) && isEqual(x.team(), y.team()); + } + static bool isEqual(const Fortran::evaluate::NamedEntity &x, + const Fortran::evaluate::NamedEntity &y) { + if (x.IsSymbol() && y.IsSymbol()) + return isEqual(x.GetFirstSymbol(), y.GetFirstSymbol()); + return !x.IsSymbol() && !y.IsSymbol() && + isEqual(x.GetComponent(), y.GetComponent()); + } + static bool isEqual(const Fortran::evaluate::DataRef &x, + const Fortran::evaluate::DataRef &y) { + return std::visit( + [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u); + } + static bool isEqual(const Fortran::evaluate::ComplexPart &x, + const Fortran::evaluate::ComplexPart &y) { + return isEqual(x.complex(), y.complex()) && x.part() == y.part(); + } + template + static bool isEqual(const Fortran::evaluate::Convert &x, + const Fortran::evaluate::Convert &y) { + return isEqual(x.left(), y.left()); + } + template + static bool isEqual(const Fortran::evaluate::ComplexComponent &x, + const Fortran::evaluate::ComplexComponent &y) { + return isEqual(x.left(), y.left()) && + x.isImaginaryPart == y.isImaginaryPart; + } + template + static bool isEqual(const Fortran::evaluate::Parentheses &x, + const Fortran::evaluate::Parentheses &y) { + return isEqual(x.left(), y.left()); + } + template + static bool isEqual(const Fortran::evaluate::Negate &x, + const Fortran::evaluate::Negate &y) { + return isEqual(x.left(), y.left()); + } + template + static bool isBinaryEqual(const A &x, const A &y) { + return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right()); + } + template + static bool isEqual(const Fortran::evaluate::Add &x, + const Fortran::evaluate::Add &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::Subtract &x, + const Fortran::evaluate::Subtract &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::Multiply &x, + const Fortran::evaluate::Multiply &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::Divide &x, + const Fortran::evaluate::Divide &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::Power &x, + const Fortran::evaluate::Power &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::Extremum &x, + const Fortran::evaluate::Extremum &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::RealToIntPower &x, + const Fortran::evaluate::RealToIntPower &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::ComplexConstructor &x, + const Fortran::evaluate::ComplexConstructor &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::Concat &x, + const Fortran::evaluate::Concat &y) { + return isBinaryEqual(x, y); + } + template + static bool isEqual(const Fortran::evaluate::SetLength &x, + const Fortran::evaluate::SetLength &y) { + return isBinaryEqual(x, y); + } + static bool isEqual(const Fortran::semantics::SymbolRef &x, + const Fortran::semantics::SymbolRef &y) { + return isEqual(x.get(), y.get()); + } + static bool isEqual(const Fortran::evaluate::Substring &x, + const Fortran::evaluate::Substring &y) { + return std::visit( + [&](const auto &p, const auto &q) { return isEqual(p, q); }, + x.parent(), y.parent()) && + isEqual(x.lower(), y.lower()) && isEqual(x.lower(), y.lower()); + } + static bool isEqual(const Fortran::evaluate::StaticDataObject::Pointer &x, + const Fortran::evaluate::StaticDataObject::Pointer &y) { + return x->name() == y->name(); + } + static bool isEqual(const Fortran::evaluate::SpecificIntrinsic &x, + const Fortran::evaluate::SpecificIntrinsic &y) { + return x.name == y.name; + } + template + static bool isEqual(const Fortran::evaluate::Constant &x, + const Fortran::evaluate::Constant &y) { + return x == y; + } + static bool isEqual(const Fortran::evaluate::ActualArgument &x, + const Fortran::evaluate::ActualArgument &y) { + if (const Fortran::evaluate::Symbol *xs = x.GetAssumedTypeDummy()) { + if (const Fortran::evaluate::Symbol *ys = y.GetAssumedTypeDummy()) + return isEqual(*xs, *ys); + return false; + } + return !y.GetAssumedTypeDummy() && + isEqual(*x.UnwrapExpr(), *y.UnwrapExpr()); + } + static bool isEqual(const Fortran::evaluate::ProcedureDesignator &x, + const Fortran::evaluate::ProcedureDesignator &y) { + return std::visit( + [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u); + } + static bool isEqual(const Fortran::evaluate::ProcedureRef &x, + const Fortran::evaluate::ProcedureRef &y) { + return isEqual(x.proc(), y.proc()) && isEqual(x.arguments(), y.arguments()); + } + template + static bool isEqual(const Fortran::evaluate::ArrayConstructor &x, + const Fortran::evaluate::ArrayConstructor &y) { + llvm::report_fatal_error("not implemented"); + } + static bool isEqual(const Fortran::evaluate::ImpliedDoIndex &x, + const Fortran::evaluate::ImpliedDoIndex &y) { + return toStringRef(x.name) == toStringRef(y.name); + } + static bool isEqual(const Fortran::evaluate::TypeParamInquiry &x, + const Fortran::evaluate::TypeParamInquiry &y) { + return isEqual(x.base(), y.base()) && isEqual(x.parameter(), y.parameter()); + } + static bool isEqual(const Fortran::evaluate::DescriptorInquiry &x, + const Fortran::evaluate::DescriptorInquiry &y) { + return isEqual(x.base(), y.base()) && x.field() == y.field() && + x.dimension() == y.dimension(); + } + static bool isEqual(const Fortran::evaluate::StructureConstructor &x, + const Fortran::evaluate::StructureConstructor &y) { + llvm::report_fatal_error("not implemented"); + } + template + static bool isEqual(const Fortran::evaluate::Not &x, + const Fortran::evaluate::Not &y) { + return isEqual(x.left(), y.left()); + } + template + static bool isEqual(const Fortran::evaluate::LogicalOperation &x, + const Fortran::evaluate::LogicalOperation &y) { + return isEqual(x.left(), y.left()) && isEqual(x.right(), x.right()); + } + template + static bool isEqual(const Fortran::evaluate::Relational &x, + const Fortran::evaluate::Relational &y) { + return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right()); + } + template + static bool isEqual(const Fortran::evaluate::Expr &x, + const Fortran::evaluate::Expr &y) { + return std::visit( + [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u); + } + static bool + isEqual(const Fortran::evaluate::Relational &x, + const Fortran::evaluate::Relational &y) { + return std::visit( + [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u); + } + template + static bool isEqual(const Fortran::evaluate::Designator &x, + const Fortran::evaluate::Designator &y) { + return std::visit( + [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u); + } + template + static bool isEqual(const Fortran::evaluate::value::Integer &x, + const Fortran::evaluate::value::Integer &y) { + return x == y; + } + static bool isEqual(const Fortran::evaluate::NullPointer &x, + const Fortran::evaluate::NullPointer &y) { + return true; + } + template , bool> = true> + static bool isEqual(const A &, const B &) { + return false; + } +}; +} // namespace + +bool Fortran::lower::isEqual( + const Fortran::lower::ExplicitIterSpace::ArrayBases &x, + const Fortran::lower::ExplicitIterSpace::ArrayBases &y) { + return std::visit( + Fortran::common::visitors{ + // Fortran::semantics::Symbol * are the exception here. These pointers + // have identity; if two Symbol * values are the same (different) then + // they are the same (different) logical symbol. + [&](Fortran::lower::FrontEndSymbol p, + Fortran::lower::FrontEndSymbol q) { return p == q; }, + [&](const auto *p, const auto *q) { + if constexpr (std::is_same_v) { + LLVM_DEBUG(llvm::dbgs() + << "is equal: " << p << ' ' << q << ' ' + << IsEqualEvaluateExpr::isEqual(*p, *q) << '\n'); + return IsEqualEvaluateExpr::isEqual(*p, *q); + } else { + // Different subtree types are never equal. + return false; + } + }}, + x, y); +} + +bool Fortran::lower::isEqual(Fortran::lower::FrontEndExpr x, + Fortran::lower::FrontEndExpr y) { + auto empty = llvm::DenseMapInfo::getEmptyKey(); + auto tombstone = + llvm::DenseMapInfo::getTombstoneKey(); + if (x == empty || y == empty || x == tombstone || y == tombstone) + return x == y; + return x == y || IsEqualEvaluateExpr::isEqual(*x, *y); +} + +namespace { + +/// This class can recover the base array in an expression that contains +/// explicit iteration space symbols. Most of the class can be ignored as it is +/// boilerplate Fortran::evaluate::Expr traversal. +class ArrayBaseFinder { +public: + using RT = bool; + + ArrayBaseFinder(llvm::ArrayRef syms) + : controlVars(syms.begin(), syms.end()) {} + + template + void operator()(const T &x) { + (void)find(x); + } + + /// Get the list of bases. + llvm::ArrayRef + getBases() const { + LLVM_DEBUG(llvm::dbgs() + << "number of array bases found: " << bases.size() << '\n'); + return bases; + } + +private: + // First, the cases that are of interest. + RT find(const Fortran::semantics::Symbol &symbol) { + if (symbol.Rank() > 0) { + bases.push_back(&symbol); + return true; + } + return {}; + } + RT find(const Fortran::evaluate::Component &x) { + auto found = find(x.base()); + if (!found && x.base().Rank() == 0 && x.Rank() > 0) { + bases.push_back(&x); + return true; + } + return found; + } + RT find(const Fortran::evaluate::ArrayRef &x) { + for (const auto &sub : x.subscript()) + (void)find(sub); + if (x.base().IsSymbol()) { + if (x.Rank() > 0 || intersection(x.subscript())) { + bases.push_back(&x); + return true; + } + return {}; + } + auto found = find(x.base()); + if (!found && ((x.base().Rank() == 0 && x.Rank() > 0) || + intersection(x.subscript()))) { + bases.push_back(&x); + return true; + } + return found; + } + RT find(const Fortran::evaluate::Triplet &x) { + if (const auto *lower = x.GetLower()) + (void)find(*lower); + if (const auto *upper = x.GetUpper()) + (void)find(*upper); + return find(x.GetStride()); + } + RT find(const Fortran::evaluate::IndirectSubscriptIntegerExpr &x) { + return find(x.value()); + } + RT find(const Fortran::evaluate::Subscript &x) { return find(x.u); } + RT find(const Fortran::evaluate::DataRef &x) { return find(x.u); } + RT find(const Fortran::evaluate::CoarrayRef &x) { + assert(false && "coarray reference"); + return {}; + } + + template + bool intersection(const A &subscripts) { + return Fortran::lower::symbolsIntersectSubscripts(controlVars, subscripts); + } + + // The rest is traversal boilerplate and can be ignored. + RT find(const Fortran::evaluate::Substring &x) { return find(x.parent()); } + template + RT find(const Fortran::semantics::SymbolRef x) { + return find(*x); + } + RT find(const Fortran::evaluate::NamedEntity &x) { + if (x.IsSymbol()) + return find(x.GetFirstSymbol()); + return find(x.GetComponent()); + } + + template + RT find(const Fortran::common::Indirection &x) { + return find(x.value()); + } + template + RT find(const std::unique_ptr &x) { + return find(x.get()); + } + template + RT find(const std::shared_ptr &x) { + return find(x.get()); + } + template + RT find(const A *x) { + if (x) + return find(*x); + return {}; + } + template + RT find(const std::optional &x) { + if (x) + return find(*x); + return {}; + } + template + RT find(const std::variant &u) { + return std::visit([&](const auto &v) { return find(v); }, u); + } + template + RT find(const std::vector &x) { + for (auto &v : x) + (void)find(v); + return {}; + } + RT find(const Fortran::evaluate::BOZLiteralConstant &) { return {}; } + RT find(const Fortran::evaluate::NullPointer &) { return {}; } + template + RT find(const Fortran::evaluate::Constant &x) { + return {}; + } + RT find(const Fortran::evaluate::StaticDataObject &) { return {}; } + RT find(const Fortran::evaluate::ImpliedDoIndex &) { return {}; } + RT find(const Fortran::evaluate::BaseObject &x) { + (void)find(x.u); + return {}; + } + RT find(const Fortran::evaluate::TypeParamInquiry &) { return {}; } + RT find(const Fortran::evaluate::ComplexPart &x) { return {}; } + template + RT find(const Fortran::evaluate::Designator &x) { + return find(x.u); + } + template + RT find(const Fortran::evaluate::Variable &x) { + return find(x.u); + } + RT find(const Fortran::evaluate::DescriptorInquiry &) { return {}; } + RT find(const Fortran::evaluate::SpecificIntrinsic &) { return {}; } + RT find(const Fortran::evaluate::ProcedureDesignator &x) { return {}; } + RT find(const Fortran::evaluate::ProcedureRef &x) { + (void)find(x.proc()); + if (x.IsElemental()) + (void)find(x.arguments()); + return {}; + } + RT find(const Fortran::evaluate::ActualArgument &x) { + if (const auto *sym = x.GetAssumedTypeDummy()) + (void)find(*sym); + else + (void)find(x.UnwrapExpr()); + return {}; + } + template + RT find(const Fortran::evaluate::FunctionRef &x) { + (void)find(static_cast(x)); + return {}; + } + template + RT find(const Fortran::evaluate::ArrayConstructorValue &) { + return {}; + } + template + RT find(const Fortran::evaluate::ArrayConstructorValues &) { + return {}; + } + template + RT find(const Fortran::evaluate::ImpliedDo &) { + return {}; + } + RT find(const Fortran::semantics::ParamValue &) { return {}; } + RT find(const Fortran::semantics::DerivedTypeSpec &) { return {}; } + RT find(const Fortran::evaluate::StructureConstructor &) { return {}; } + template + RT find(const Fortran::evaluate::Operation &op) { + (void)find(op.left()); + return false; + } + template + RT find(const Fortran::evaluate::Operation &op) { + (void)find(op.left()); + (void)find(op.right()); + return false; + } + RT find(const Fortran::evaluate::Relational &x) { + (void)find(x.u); + return {}; + } + template + RT find(const Fortran::evaluate::Expr &x) { + (void)find(x.u); + return {}; + } + + llvm::SmallVector bases; + llvm::SmallVector controlVars; +}; + +} // namespace + +void Fortran::lower::ExplicitIterSpace::leave() { + ccLoopNest.pop_back(); + --forallContextOpen; + conditionalCleanup(); +} + +void Fortran::lower::ExplicitIterSpace::addSymbol( + Fortran::lower::FrontEndSymbol sym) { + assert(!symbolStack.empty()); + symbolStack.back().push_back(sym); +} + +void Fortran::lower::ExplicitIterSpace::exprBase(Fortran::lower::FrontEndExpr x, + bool lhs) { + ArrayBaseFinder finder(collectAllSymbols()); + finder(*x); + llvm::ArrayRef bases = + finder.getBases(); + if (rhsBases.empty()) + endAssign(); + if (lhs) { + if (bases.empty()) { + lhsBases.push_back(llvm::None); + return; + } + assert(bases.size() >= 1 && "must detect an array reference on lhs"); + if (bases.size() > 1) + rhsBases.back().append(bases.begin(), bases.end() - 1); + lhsBases.push_back(bases.back()); + return; + } + rhsBases.back().append(bases.begin(), bases.end()); +} + +void Fortran::lower::ExplicitIterSpace::endAssign() { rhsBases.emplace_back(); } + +void Fortran::lower::ExplicitIterSpace::pushLevel() { + symbolStack.push_back(llvm::SmallVector{}); +} + +void Fortran::lower::ExplicitIterSpace::popLevel() { symbolStack.pop_back(); } + +void Fortran::lower::ExplicitIterSpace::conditionalCleanup() { + if (forallContextOpen == 0) { + // Exiting the outermost FORALL context. + // Cleanup any residual mask buffers. + outermostContext().finalize(); + // Clear and reset all the cached information. + symbolStack.clear(); + lhsBases.clear(); + rhsBases.clear(); + loadBindings.clear(); + ccLoopNest.clear(); + innerArgs.clear(); + outerLoop = llvm::None; + clearLoops(); + counter = 0; + } +} + +llvm::Optional +Fortran::lower::ExplicitIterSpace::findArgPosition(fir::ArrayLoadOp load) { + if (lhsBases[counter].hasValue()) { + auto ld = loadBindings.find(lhsBases[counter].getValue()); + llvm::Optional optPos; + if (ld != loadBindings.end() && ld->second == load) + optPos = static_cast(0u); + assert(optPos.hasValue() && "load does not correspond to lhs"); + return optPos; + } + return llvm::None; +} + +llvm::SmallVector +Fortran::lower::ExplicitIterSpace::collectAllSymbols() { + llvm::SmallVector result; + for (llvm::SmallVector vec : symbolStack) + result.append(vec.begin(), vec.end()); + return result; +} + +llvm::raw_ostream & +Fortran::lower::operator<<(llvm::raw_ostream &s, + const Fortran::lower::ImplicitIterSpace &e) { + for (const llvm::SmallVector< + Fortran::lower::ImplicitIterSpace::FrontEndMaskExpr> &xs : + e.getMasks()) { + s << "{ "; + for (const Fortran::lower::ImplicitIterSpace::FrontEndMaskExpr &x : xs) + x->AsFortran(s << '(') << "), "; + s << "}\n"; + } + return s; +} + +llvm::raw_ostream & +Fortran::lower::operator<<(llvm::raw_ostream &s, + const Fortran::lower::ExplicitIterSpace &e) { + auto dump = [&](const auto &u) { + std::visit(Fortran::common::visitors{ + [&](const Fortran::semantics::Symbol *y) { + s << " " << *y << '\n'; + }, + [&](const Fortran::evaluate::ArrayRef *y) { + s << " "; + if (y->base().IsSymbol()) + s << y->base().GetFirstSymbol(); + else + s << y->base().GetComponent().GetLastSymbol(); + s << '\n'; + }, + [&](const Fortran::evaluate::Component *y) { + s << " " << y->GetLastSymbol() << '\n'; + }}, + u); + }; + s << "LHS bases:\n"; + for (const llvm::Optional &u : + e.lhsBases) + if (u.hasValue()) + dump(u.getValue()); + s << "RHS bases:\n"; + for (const llvm::SmallVector + &bases : e.rhsBases) { + for (const Fortran::lower::ExplicitIterSpace::ArrayBases &u : bases) + dump(u); + s << '\n'; + } + return s; +} + +void Fortran::lower::ImplicitIterSpace::dump() const { + llvm::errs() << *this << '\n'; +} + +void Fortran::lower::ExplicitIterSpace::dump() const { + llvm::errs() << *this << '\n'; +} diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -390,6 +390,57 @@ [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); }); } +mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc, + const fir::ExtendedValue &exv, + mlir::ValueRange triples, + mlir::ValueRange path) { + if (triples.empty()) { + // If there is no slicing by triple notation, then take the whole array. + auto fullShape = [&](const llvm::ArrayRef lbounds, + llvm::ArrayRef extents) -> mlir::Value { + llvm::SmallVector trips; + auto idxTy = getIndexType(); + auto one = createIntegerConstant(loc, idxTy, 1); + if (lbounds.empty()) { + for (auto v : extents) { + trips.push_back(one); + trips.push_back(v); + trips.push_back(one); + } + return create(loc, trips, path); + } + for (auto [lbnd, extent] : llvm::zip(lbounds, extents)) { + auto lb = createConvert(loc, idxTy, lbnd); + auto ext = createConvert(loc, idxTy, extent); + auto shift = create(loc, lb, one); + auto ub = create(loc, ext, shift); + trips.push_back(lb); + trips.push_back(ub); + trips.push_back(one); + } + return create(loc, trips, path); + }; + return exv.match( + [&](const fir::ArrayBoxValue &box) { + return fullShape(box.getLBounds(), box.getExtents()); + }, + [&](const fir::CharArrayBoxValue &box) { + return fullShape(box.getLBounds(), box.getExtents()); + }, + [&](const fir::BoxValue &box) { + auto extents = fir::factory::readExtents(*this, loc, box); + return fullShape(box.getLBounds(), extents); + }, + [&](const fir::MutableBoxValue &) -> mlir::Value { + // MutableBoxValue must be read into another category to work with + // them outside of allocation/assignment contexts. + fir::emitFatalError(loc, "createSlice on MutableBoxValue"); + }, + [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); }); + } + return create(loc, triples, path); +} + mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc, const fir::ExtendedValue &exv) { mlir::Value itemAddr = fir::getBase(exv); @@ -518,6 +569,35 @@ }); } +mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &box, + unsigned dim, + mlir::Value defaultValue) { + assert(box.rank() > dim); + auto lb = box.match( + [&](const fir::ArrayBoxValue &x) -> mlir::Value { + return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim]; + }, + [&](const fir::CharArrayBoxValue &x) -> mlir::Value { + return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim]; + }, + [&](const fir::BoxValue &x) -> mlir::Value { + return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim]; + }, + [&](const fir::MutableBoxValue &x) -> mlir::Value { + return readLowerBound(builder, loc, + fir::factory::genMutableBoxRead(builder, loc, x), + dim, defaultValue); + }, + [&](const auto &) -> mlir::Value { + fir::emitFatalError(loc, "lower bound inquiry on scalar"); + }); + if (lb) + return lb; + return defaultValue; +} + llvm::SmallVector fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc, const fir::BoxValue &box) { @@ -653,6 +733,111 @@ return extents; } +// FIXME: This needs some work. To correctly determine the extended value of a +// component, one needs the base object, its type, and its type parameters. (An +// alternative would be to provide an already computed address of the final +// component rather than the base object's address, the point being the result +// will require the address of the final component to create the extended +// value.) One further needs the full path of components being applied. One +// needs to apply type-based expressions to type parameters along this said +// path. (See applyPathToType for a type-only derivation.) Finally, one needs to +// compose the extended value of the terminal component, including all of its +// parameters: array lower bounds expressions, extents, type parameters, etc. +// Any of these properties may be deferred until runtime in Fortran. This +// operation may therefore generate a sizeable block of IR, including calls to +// type-based helper functions, so caching the result of this operation in the +// client would be advised as well. +fir::ExtendedValue fir::factory::componentToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) { + auto fieldTy = component.getType(); + if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy)) + fieldTy = ty; + if (fieldTy.isa()) { + llvm::SmallVector nonDeferredTypeParams; + auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy)); + if (auto charTy = eleTy.dyn_cast()) { + auto lenTy = builder.getCharacterLengthType(); + if (charTy.hasConstantLen()) + nonDeferredTypeParams.emplace_back( + builder.createIntegerConstant(loc, lenTy, charTy.getLen())); + // TODO: Starting, F2003, the dynamic character length might be dependent + // on a PDT length parameter. There is no way to make a difference with + // deferred length here yet. + } + if (auto recTy = eleTy.dyn_cast()) + if (recTy.getNumLenParams() > 0) + TODO(loc, "allocatable and pointer components non deferred length " + "parameters"); + + return fir::MutableBoxValue(component, nonDeferredTypeParams, + /*mutableProperties=*/{}); + } + llvm::SmallVector extents; + if (auto seqTy = fieldTy.dyn_cast()) { + fieldTy = seqTy.getEleTy(); + auto idxTy = builder.getIndexType(); + for (auto extent : seqTy.getShape()) { + if (extent == fir::SequenceType::getUnknownExtent()) + TODO(loc, "array component shape depending on length parameters"); + extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent)); + } + } + if (auto charTy = fieldTy.dyn_cast()) { + auto cstLen = charTy.getLen(); + if (cstLen == fir::CharacterType::unknownLen()) + TODO(loc, "get character component length from length type parameters"); + auto len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), cstLen); + if (!extents.empty()) + return fir::CharArrayBoxValue{component, len, extents}; + return fir::CharBoxValue{component, len}; + } + if (auto recordTy = fieldTy.dyn_cast()) + if (recordTy.getNumLenParams() != 0) + TODO(loc, + "lower component ref that is a derived type with length parameter"); + if (!extents.empty()) + return fir::ArrayBoxValue{component, extents}; + return component; +} + +fir::ExtendedValue fir::factory::arrayElementToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &array, mlir::Value element) { + return array.match( + [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue { + return cb.clone(element); + }, + [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue { + return bv.cloneElement(element); + }, + [&](const fir::BoxValue &box) -> fir::ExtendedValue { + if (box.isCharacter()) { + auto len = fir::factory::readCharLen(builder, loc, box); + return fir::CharBoxValue{element, len}; + } + if (box.isDerivedWithLengthParameters()) + TODO(loc, "get length parameters from derived type BoxValue"); + return element; + }, + [&](const auto &) -> fir::ExtendedValue { return element; }); +} + +fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) { + if (!slice) + return arrayElementToExtendedValue(builder, loc, array, element); + auto sliceOp = mlir::dyn_cast_or_null(slice.getDefiningOp()); + assert(sliceOp && "slice must be a sliceOp"); + if (sliceOp.getFields().empty()) + return arrayElementToExtendedValue(builder, loc, array, element); + // For F95, using componentToExtendedValue will work, but when PDTs are + // lowered. It will be required to go down the slice to propagate the length + // parameters. + return fir::factory::componentToExtendedValue(builder, loc, element); +} + mlir::TupleType fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) { mlir::IntegerType i64Ty = builder.getIntegerType(64); diff --git a/flang/test/Lower/assignment.f90 b/flang/test/Lower/assignment.f90 --- a/flang/test/Lower/assignment.f90 +++ b/flang/test/Lower/assignment.f90 @@ -298,3 +298,39 @@ ! CHECK: %[[INS0:.*]] = fir.insert_value %[[UNDEF]], %[[C0]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> ! CHECK: %[[INS1:.*]] = fir.insert_value %[[INS0]], %[[C1]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> ! CHECK: fir.store %[[INS1]] to %[[A]] : !fir.ref> + +subroutine sub1_arr(a) + integer :: a(10) + a(2) = 10 +end + +! CHECK-LABEL: func @_QPsub1_arr( +! CHECK-SAME: %[[A:.*]]: !fir.ref> {fir.bindc_name = "a"}) +! CHECK-DAG: %[[C10:.*]] = arith.constant 10 : i32 +! CHECK-DAG: %[[C2:.*]] = arith.constant 2 : i64 +! CHECK-DAG: %[[C1:.*]] = arith.constant 1 : i64 +! CHECK: %[[ZERO_BASED_INDEX:.*]] = arith.subi %[[C2]], %[[C1]] : i64 +! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[A]], %[[ZERO_BASED_INDEX]] : (!fir.ref>, i64) -> !fir.ref +! CHECK: fir.store %[[C10]] to %[[COORD]] : !fir.ref +! CHECK: return + +subroutine sub2_arr(a) + integer :: a(10) + a = 10 +end + +! CHECK-LABEL: func @_QPsub2_arr( +! CHECK-SAME: %[[A:.*]]: !fir.ref> {fir.bindc_name = "a"}) +! CHECK-DAG: %[[C10_0:.*]] = arith.constant 10 : index +! CHECK: %[[SHAPE:.*]] = fir.shape %[[C10_0]] : (index) -> !fir.shape<1> +! CHECK: %[[LOAD:.*]] = fir.array_load %[[A]](%[[SHAPE]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<10xi32> +! CHECK-DAG: %[[C10_1:.*]] = arith.constant 10 : i32 +! CHECK-DAG: %[[C1:.*]] = arith.constant 1 : index +! CHECK-DAG: %[[C0:.*]] = arith.constant 0 : index +! CHECK-DAG: %[[UB:.*]] = arith.subi %[[C10_0]], %c1 : index +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[ARG1:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG2:.*]] = %[[LOAD]]) -> (!fir.array<10xi32>) { +! CHECK: %[[RES:.*]] = fir.array_update %[[ARG2]], %[[C10_1]], %[[ARG1]] : (!fir.array<10xi32>, i32, index) -> !fir.array<10xi32> +! CHECK: fir.result %[[RES]] : !fir.array<10xi32> +! CHECK: } +! CHECK: fir.array_merge_store %[[LOAD]], %[[DO_RES]] to %[[A]] : !fir.array<10xi32>, !fir.array<10xi32>, !fir.ref> +! CHECK: return diff --git a/flang/test/Lower/basic-function.f90 b/flang/test/Lower/basic-function.f90 --- a/flang/test/Lower/basic-function.f90 +++ b/flang/test/Lower/basic-function.f90 @@ -62,20 +62,6 @@ ! CHECK-LABEL: func @_QPfct_iarr2() -> !fir.array<10x20xi32> ! CHECK: return %{{.*}} : !fir.array<10x20xi32> -function fct_iarr3() - integer, dimension(:, :), allocatable :: fct_iarr3 -end - -! CHECK-LABEL: func @_QPfct_iarr3() -> !fir.box>> -! CHECK: return %{{.*}} : !fir.box>> - -function fct_iarr4() - integer, dimension(:), pointer :: fct_iarr4 -end - -! CHECK-LABEL: func @_QPfct_iarr4() -> !fir.box>> -! CHECK: return %{{.*}} : !fir.box>> - logical(1) function lfct1() end ! CHECK-LABEL: func @_QPlfct1() -> !fir.logical<1>