874 lines · cpp
1//===-- Lower/Support/Utils.cpp -- utilities --------------------*- C++ -*-===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8//9// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/10//11//===----------------------------------------------------------------------===//12 13#include "flang/Lower/Support/Utils.h"14 15#include "flang/Common/indirection.h"16#include "flang/Lower/AbstractConverter.h"17#include "flang/Lower/ConvertVariable.h"18#include "flang/Lower/IterationSpace.h"19#include "flang/Lower/Support/PrivateReductionUtils.h"20#include "flang/Optimizer/Builder/HLFIRTools.h"21#include "flang/Optimizer/Builder/Todo.h"22#include "flang/Optimizer/HLFIR/HLFIRDialect.h"23#include "flang/Semantics/tools.h"24#include "mlir/Dialect/OpenMP/OpenMPDialect.h"25#include <cstdint>26#include <optional>27#include <type_traits>28 29namespace Fortran::lower {30// Fortran::evaluate::Expr are functional values organized like an AST. A31// Fortran::evaluate::Expr is meant to be moved and cloned. Using the front end32// tools can often cause copies and extra wrapper classes to be added to any33// Fortran::evaluate::Expr. These values should not be assumed or relied upon to34// have an *object* identity. They are deeply recursive, irregular structures35// built from a large number of classes which do not use inheritance and36// necessitate a large volume of boilerplate code as a result.37//38// Contrastingly, LLVM data structures make ubiquitous assumptions about an39// object's identity via pointers to the object. An object's location in memory40// is thus very often an identifying relation.41 42// This class defines a hash computation of a Fortran::evaluate::Expr tree value43// so it can be used with llvm::DenseMap. The Fortran::evaluate::Expr need not44// have the same address.45class HashEvaluateExpr {46public:47 // A Se::Symbol is the only part of an Fortran::evaluate::Expr with an48 // identity property.49 static unsigned getHashValue(const Fortran::semantics::Symbol &x) {50 return static_cast<unsigned>(reinterpret_cast<std::intptr_t>(&x));51 }52 template <typename A, bool COPY>53 static unsigned getHashValue(const Fortran::common::Indirection<A, COPY> &x) {54 return getHashValue(x.value());55 }56 template <typename A>57 static unsigned getHashValue(const std::optional<A> &x) {58 if (x.has_value())59 return getHashValue(x.value());60 return 0u;61 }62 static unsigned getHashValue(const Fortran::evaluate::Subscript &x) {63 return Fortran::common::visit(64 [&](const auto &v) { return getHashValue(v); }, x.u);65 }66 static unsigned getHashValue(const Fortran::evaluate::Triplet &x) {67 return getHashValue(x.lower()) - getHashValue(x.upper()) * 5u -68 getHashValue(x.stride()) * 11u;69 }70 static unsigned getHashValue(const Fortran::evaluate::Component &x) {71 return getHashValue(x.base()) * 83u - getHashValue(x.GetLastSymbol());72 }73 static unsigned getHashValue(const Fortran::evaluate::ArrayRef &x) {74 unsigned subs = 1u;75 for (const Fortran::evaluate::Subscript &v : x.subscript())76 subs -= getHashValue(v);77 return getHashValue(x.base()) * 89u - subs;78 }79 static unsigned getHashValue(const Fortran::evaluate::CoarrayRef &x) {80 unsigned cosubs = 3u;81 for (const Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger> &v :82 x.cosubscript())83 cosubs -= getHashValue(v);84 return getHashValue(x.base()) * 97u - cosubs + getHashValue(x.stat()) +85 257u + getHashValue(x.team()) + getHashValue(x.notify());86 }87 static unsigned getHashValue(const Fortran::evaluate::NamedEntity &x) {88 if (x.IsSymbol())89 return getHashValue(x.GetFirstSymbol()) * 11u;90 return getHashValue(x.GetComponent()) * 13u;91 }92 static unsigned getHashValue(const Fortran::evaluate::DataRef &x) {93 return Fortran::common::visit(94 [&](const auto &v) { return getHashValue(v); }, x.u);95 }96 static unsigned getHashValue(const Fortran::evaluate::ComplexPart &x) {97 return getHashValue(x.complex()) - static_cast<unsigned>(x.part());98 }99 template <Fortran::common::TypeCategory TC1, int KIND,100 Fortran::common::TypeCategory TC2>101 static unsigned getHashValue(102 const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>103 &x) {104 return getHashValue(x.left()) - (static_cast<unsigned>(TC1) + 2u) -105 (static_cast<unsigned>(KIND) + 5u);106 }107 template <int KIND>108 static unsigned109 getHashValue(const Fortran::evaluate::ComplexComponent<KIND> &x) {110 return getHashValue(x.left()) -111 (static_cast<unsigned>(x.isImaginaryPart) + 1u) * 3u;112 }113 template <typename T>114 static unsigned getHashValue(const Fortran::evaluate::Parentheses<T> &x) {115 return getHashValue(x.left()) * 17u;116 }117 template <Fortran::common::TypeCategory TC, int KIND>118 static unsigned getHashValue(119 const Fortran::evaluate::Negate<Fortran::evaluate::Type<TC, KIND>> &x) {120 return getHashValue(x.left()) - (static_cast<unsigned>(TC) + 5u) -121 (static_cast<unsigned>(KIND) + 7u);122 }123 template <Fortran::common::TypeCategory TC, int KIND>124 static unsigned getHashValue(125 const Fortran::evaluate::Add<Fortran::evaluate::Type<TC, KIND>> &x) {126 return (getHashValue(x.left()) + getHashValue(x.right())) * 23u +127 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);128 }129 template <Fortran::common::TypeCategory TC, int KIND>130 static unsigned getHashValue(131 const Fortran::evaluate::Subtract<Fortran::evaluate::Type<TC, KIND>> &x) {132 return (getHashValue(x.left()) - getHashValue(x.right())) * 19u +133 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);134 }135 template <Fortran::common::TypeCategory TC, int KIND>136 static unsigned getHashValue(137 const Fortran::evaluate::Multiply<Fortran::evaluate::Type<TC, KIND>> &x) {138 return (getHashValue(x.left()) + getHashValue(x.right())) * 29u +139 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);140 }141 template <Fortran::common::TypeCategory TC, int KIND>142 static unsigned getHashValue(143 const Fortran::evaluate::Divide<Fortran::evaluate::Type<TC, KIND>> &x) {144 return (getHashValue(x.left()) - getHashValue(x.right())) * 31u +145 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);146 }147 template <Fortran::common::TypeCategory TC, int KIND>148 static unsigned getHashValue(149 const Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>> &x) {150 return (getHashValue(x.left()) - getHashValue(x.right())) * 37u +151 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);152 }153 template <Fortran::common::TypeCategory TC, int KIND>154 static unsigned getHashValue(155 const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>> &x) {156 return (getHashValue(x.left()) + getHashValue(x.right())) * 41u +157 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND) +158 static_cast<unsigned>(x.ordering) * 7u;159 }160 template <Fortran::common::TypeCategory TC, int KIND>161 static unsigned getHashValue(162 const Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>163 &x) {164 return (getHashValue(x.left()) - getHashValue(x.right())) * 43u +165 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);166 }167 template <int KIND>168 static unsigned169 getHashValue(const Fortran::evaluate::ComplexConstructor<KIND> &x) {170 return (getHashValue(x.left()) - getHashValue(x.right())) * 47u +171 static_cast<unsigned>(KIND);172 }173 template <int KIND>174 static unsigned getHashValue(const Fortran::evaluate::Concat<KIND> &x) {175 return (getHashValue(x.left()) - getHashValue(x.right())) * 53u +176 static_cast<unsigned>(KIND);177 }178 template <int KIND>179 static unsigned getHashValue(const Fortran::evaluate::SetLength<KIND> &x) {180 return (getHashValue(x.left()) - getHashValue(x.right())) * 59u +181 static_cast<unsigned>(KIND);182 }183 static unsigned getHashValue(const Fortran::semantics::SymbolRef &sym) {184 return getHashValue(sym.get());185 }186 static unsigned getHashValue(const Fortran::evaluate::Substring &x) {187 return 61u *188 Fortran::common::visit(189 [&](const auto &p) { return getHashValue(p); }, x.parent()) -190 getHashValue(x.lower()) - (getHashValue(x.lower()) + 1u);191 }192 static unsigned193 getHashValue(const Fortran::evaluate::StaticDataObject::Pointer &x) {194 return llvm::hash_value(x->name());195 }196 static unsigned getHashValue(const Fortran::evaluate::SpecificIntrinsic &x) {197 return llvm::hash_value(x.name);198 }199 template <typename A>200 static unsigned getHashValue(const Fortran::evaluate::Constant<A> &x) {201 // FIXME: Should hash the content.202 return 103u;203 }204 static unsigned getHashValue(const Fortran::evaluate::ActualArgument &x) {205 if (const Fortran::evaluate::Symbol *sym = x.GetAssumedTypeDummy())206 return getHashValue(*sym);207 return getHashValue(*x.UnwrapExpr());208 }209 static unsigned210 getHashValue(const Fortran::evaluate::ProcedureDesignator &x) {211 return Fortran::common::visit(212 [&](const auto &v) { return getHashValue(v); }, x.u);213 }214 static unsigned getHashValue(const Fortran::evaluate::ProcedureRef &x) {215 unsigned args = 13u;216 for (const std::optional<Fortran::evaluate::ActualArgument> &v :217 x.arguments())218 args -= getHashValue(v);219 return getHashValue(x.proc()) * 101u - args;220 }221 template <typename A>222 static unsigned223 getHashValue(const Fortran::evaluate::ArrayConstructor<A> &x) {224 // FIXME: hash the contents.225 return 127u;226 }227 static unsigned getHashValue(const Fortran::evaluate::ImpliedDoIndex &x) {228 return llvm::hash_value(toStringRef(x.name).str()) * 131u;229 }230 static unsigned getHashValue(const Fortran::evaluate::TypeParamInquiry &x) {231 return getHashValue(x.base()) * 137u - getHashValue(x.parameter()) * 3u;232 }233 static unsigned getHashValue(const Fortran::evaluate::DescriptorInquiry &x) {234 return getHashValue(x.base()) * 139u -235 static_cast<unsigned>(x.field()) * 13u +236 static_cast<unsigned>(x.dimension());237 }238 static unsigned239 getHashValue(const Fortran::evaluate::StructureConstructor &x) {240 // FIXME: hash the contents.241 return 149u;242 }243 template <int KIND>244 static unsigned getHashValue(const Fortran::evaluate::Not<KIND> &x) {245 return getHashValue(x.left()) * 61u + static_cast<unsigned>(KIND);246 }247 template <int KIND>248 static unsigned249 getHashValue(const Fortran::evaluate::LogicalOperation<KIND> &x) {250 unsigned result = getHashValue(x.left()) + getHashValue(x.right());251 return result * 67u + static_cast<unsigned>(x.logicalOperator) * 5u;252 }253 template <Fortran::common::TypeCategory TC, int KIND>254 static unsigned getHashValue(255 const Fortran::evaluate::Relational<Fortran::evaluate::Type<TC, KIND>>256 &x) {257 return (getHashValue(x.left()) + getHashValue(x.right())) * 71u +258 static_cast<unsigned>(TC) + static_cast<unsigned>(KIND) +259 static_cast<unsigned>(x.opr) * 11u;260 }261 template <typename A>262 static unsigned getHashValue(const Fortran::evaluate::Expr<A> &x) {263 return Fortran::common::visit(264 [&](const auto &v) { return getHashValue(v); }, x.u);265 }266 static unsigned getHashValue(267 const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x) {268 return Fortran::common::visit(269 [&](const auto &v) { return getHashValue(v); }, x.u);270 }271 template <typename A>272 static unsigned getHashValue(const Fortran::evaluate::Designator<A> &x) {273 return Fortran::common::visit(274 [&](const auto &v) { return getHashValue(v); }, x.u);275 }276 template <int BITS>277 static unsigned278 getHashValue(const Fortran::evaluate::value::Integer<BITS> &x) {279 return static_cast<unsigned>(x.ToSInt());280 }281 static unsigned getHashValue(const Fortran::evaluate::NullPointer &x) {282 return ~179u;283 }284};285 286// Define the is equals test for using Fortran::evaluate::Expr values with287// llvm::DenseMap.288class IsEqualEvaluateExpr {289public:290 // A Se::Symbol is the only part of an Fortran::evaluate::Expr with an291 // identity property.292 static bool isEqual(const Fortran::semantics::Symbol &x,293 const Fortran::semantics::Symbol &y) {294 return isEqual(&x, &y);295 }296 static bool isEqual(const Fortran::semantics::Symbol *x,297 const Fortran::semantics::Symbol *y) {298 return x == y;299 }300 template <typename A, bool COPY>301 static bool isEqual(const Fortran::common::Indirection<A, COPY> &x,302 const Fortran::common::Indirection<A, COPY> &y) {303 return isEqual(x.value(), y.value());304 }305 template <typename A>306 static bool isEqual(const std::optional<A> &x, const std::optional<A> &y) {307 if (x.has_value() && y.has_value())308 return isEqual(x.value(), y.value());309 return !x.has_value() && !y.has_value();310 }311 template <typename A>312 static bool isEqual(const std::vector<A> &x, const std::vector<A> &y) {313 if (x.size() != y.size())314 return false;315 const std::size_t size = x.size();316 for (std::remove_const_t<decltype(size)> i = 0; i < size; ++i)317 if (!isEqual(x[i], y[i]))318 return false;319 return true;320 }321 static bool isEqual(const Fortran::evaluate::Subscript &x,322 const Fortran::evaluate::Subscript &y) {323 return Fortran::common::visit(324 [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);325 }326 static bool isEqual(const Fortran::evaluate::Triplet &x,327 const Fortran::evaluate::Triplet &y) {328 return isEqual(x.lower(), y.lower()) && isEqual(x.upper(), y.upper()) &&329 isEqual(x.stride(), y.stride());330 }331 static bool isEqual(const Fortran::evaluate::Component &x,332 const Fortran::evaluate::Component &y) {333 return isEqual(x.base(), y.base()) &&334 isEqual(x.GetLastSymbol(), y.GetLastSymbol());335 }336 static bool isEqual(const Fortran::evaluate::ArrayRef &x,337 const Fortran::evaluate::ArrayRef &y) {338 return isEqual(x.base(), y.base()) && isEqual(x.subscript(), y.subscript());339 }340 static bool isEqual(const Fortran::evaluate::CoarrayRef &x,341 const Fortran::evaluate::CoarrayRef &y) {342 return isEqual(x.base(), y.base()) &&343 isEqual(x.cosubscript(), y.cosubscript()) &&344 isEqual(x.stat(), y.stat()) && isEqual(x.team(), y.team()) &&345 isEqual(x.notify(), y.notify());346 }347 static bool isEqual(const Fortran::evaluate::NamedEntity &x,348 const Fortran::evaluate::NamedEntity &y) {349 if (x.IsSymbol() && y.IsSymbol())350 return isEqual(x.GetFirstSymbol(), y.GetFirstSymbol());351 return !x.IsSymbol() && !y.IsSymbol() &&352 isEqual(x.GetComponent(), y.GetComponent());353 }354 static bool isEqual(const Fortran::evaluate::DataRef &x,355 const Fortran::evaluate::DataRef &y) {356 return Fortran::common::visit(357 [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);358 }359 static bool isEqual(const Fortran::evaluate::ComplexPart &x,360 const Fortran::evaluate::ComplexPart &y) {361 return isEqual(x.complex(), y.complex()) && x.part() == y.part();362 }363 template <typename A, Fortran::common::TypeCategory TC2>364 static bool isEqual(const Fortran::evaluate::Convert<A, TC2> &x,365 const Fortran::evaluate::Convert<A, TC2> &y) {366 return isEqual(x.left(), y.left());367 }368 template <int KIND>369 static bool isEqual(const Fortran::evaluate::ComplexComponent<KIND> &x,370 const Fortran::evaluate::ComplexComponent<KIND> &y) {371 return isEqual(x.left(), y.left()) &&372 x.isImaginaryPart == y.isImaginaryPart;373 }374 template <typename T>375 static bool isEqual(const Fortran::evaluate::Parentheses<T> &x,376 const Fortran::evaluate::Parentheses<T> &y) {377 return isEqual(x.left(), y.left());378 }379 template <typename A>380 static bool isEqual(const Fortran::evaluate::Negate<A> &x,381 const Fortran::evaluate::Negate<A> &y) {382 return isEqual(x.left(), y.left());383 }384 template <typename A>385 static bool isBinaryEqual(const A &x, const A &y) {386 return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());387 }388 template <typename A>389 static bool isEqual(const Fortran::evaluate::Add<A> &x,390 const Fortran::evaluate::Add<A> &y) {391 return isBinaryEqual(x, y);392 }393 template <typename A>394 static bool isEqual(const Fortran::evaluate::Subtract<A> &x,395 const Fortran::evaluate::Subtract<A> &y) {396 return isBinaryEqual(x, y);397 }398 template <typename A>399 static bool isEqual(const Fortran::evaluate::Multiply<A> &x,400 const Fortran::evaluate::Multiply<A> &y) {401 return isBinaryEqual(x, y);402 }403 template <typename A>404 static bool isEqual(const Fortran::evaluate::Divide<A> &x,405 const Fortran::evaluate::Divide<A> &y) {406 return isBinaryEqual(x, y);407 }408 template <typename A>409 static bool isEqual(const Fortran::evaluate::Power<A> &x,410 const Fortran::evaluate::Power<A> &y) {411 return isBinaryEqual(x, y);412 }413 template <typename A>414 static bool isEqual(const Fortran::evaluate::Extremum<A> &x,415 const Fortran::evaluate::Extremum<A> &y) {416 return isBinaryEqual(x, y);417 }418 template <typename A>419 static bool isEqual(const Fortran::evaluate::RealToIntPower<A> &x,420 const Fortran::evaluate::RealToIntPower<A> &y) {421 return isBinaryEqual(x, y);422 }423 template <int KIND>424 static bool isEqual(const Fortran::evaluate::ComplexConstructor<KIND> &x,425 const Fortran::evaluate::ComplexConstructor<KIND> &y) {426 return isBinaryEqual(x, y);427 }428 template <int KIND>429 static bool isEqual(const Fortran::evaluate::Concat<KIND> &x,430 const Fortran::evaluate::Concat<KIND> &y) {431 return isBinaryEqual(x, y);432 }433 template <int KIND>434 static bool isEqual(const Fortran::evaluate::SetLength<KIND> &x,435 const Fortran::evaluate::SetLength<KIND> &y) {436 return isBinaryEqual(x, y);437 }438 static bool isEqual(const Fortran::semantics::SymbolRef &x,439 const Fortran::semantics::SymbolRef &y) {440 return isEqual(x.get(), y.get());441 }442 static bool isEqual(const Fortran::evaluate::Substring &x,443 const Fortran::evaluate::Substring &y) {444 return Fortran::common::visit(445 [&](const auto &p, const auto &q) { return isEqual(p, q); },446 x.parent(), y.parent()) &&447 isEqual(x.lower(), y.lower()) && isEqual(x.upper(), y.upper());448 }449 static bool isEqual(const Fortran::evaluate::StaticDataObject::Pointer &x,450 const Fortran::evaluate::StaticDataObject::Pointer &y) {451 return x->name() == y->name();452 }453 static bool isEqual(const Fortran::evaluate::SpecificIntrinsic &x,454 const Fortran::evaluate::SpecificIntrinsic &y) {455 return x.name == y.name;456 }457 template <typename A>458 static bool isEqual(const Fortran::evaluate::Constant<A> &x,459 const Fortran::evaluate::Constant<A> &y) {460 return x == y;461 }462 static bool isEqual(const Fortran::evaluate::ActualArgument &x,463 const Fortran::evaluate::ActualArgument &y) {464 if (const Fortran::evaluate::Symbol *xs = x.GetAssumedTypeDummy()) {465 if (const Fortran::evaluate::Symbol *ys = y.GetAssumedTypeDummy())466 return isEqual(*xs, *ys);467 return false;468 }469 return !y.GetAssumedTypeDummy() &&470 isEqual(*x.UnwrapExpr(), *y.UnwrapExpr());471 }472 static bool isEqual(const Fortran::evaluate::ProcedureDesignator &x,473 const Fortran::evaluate::ProcedureDesignator &y) {474 return Fortran::common::visit(475 [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);476 }477 static bool isEqual(const Fortran::evaluate::ProcedureRef &x,478 const Fortran::evaluate::ProcedureRef &y) {479 return isEqual(x.proc(), y.proc()) && isEqual(x.arguments(), y.arguments());480 }481 template <typename A>482 static bool isEqual(const Fortran::evaluate::ImpliedDo<A> &x,483 const Fortran::evaluate::ImpliedDo<A> &y) {484 return isEqual(x.values(), y.values()) && isEqual(x.lower(), y.lower()) &&485 isEqual(x.upper(), y.upper()) && isEqual(x.stride(), y.stride());486 }487 template <typename A>488 static bool isEqual(const Fortran::evaluate::ArrayConstructorValues<A> &x,489 const Fortran::evaluate::ArrayConstructorValues<A> &y) {490 using Expr = Fortran::evaluate::Expr<A>;491 using ImpliedDo = Fortran::evaluate::ImpliedDo<A>;492 for (const auto &[xValue, yValue] : llvm::zip(x, y)) {493 bool checkElement = Fortran::common::visit(494 common::visitors{495 [&](const Expr &v, const Expr &w) { return isEqual(v, w); },496 [&](const ImpliedDo &v, const ImpliedDo &w) {497 return isEqual(v, w);498 },499 [&](const Expr &, const ImpliedDo &) { return false; },500 [&](const ImpliedDo &, const Expr &) { return false; },501 },502 xValue.u, yValue.u);503 if (!checkElement) {504 return false;505 }506 }507 return true;508 }509 static bool isEqual(const Fortran::evaluate::SubscriptInteger &x,510 const Fortran::evaluate::SubscriptInteger &y) {511 return x == y;512 }513 template <typename A>514 static bool isEqual(const Fortran::evaluate::ArrayConstructor<A> &x,515 const Fortran::evaluate::ArrayConstructor<A> &y) {516 bool checkCharacterType = true;517 if constexpr (A::category == Fortran::common::TypeCategory::Character) {518 checkCharacterType = isEqual(*x.LEN(), *y.LEN());519 }520 using Base = Fortran::evaluate::ArrayConstructorValues<A>;521 return isEqual((Base)x, (Base)y) &&522 (x.GetType() == y.GetType() && checkCharacterType);523 }524 static bool isEqual(const Fortran::evaluate::ImpliedDoIndex &x,525 const Fortran::evaluate::ImpliedDoIndex &y) {526 return toStringRef(x.name) == toStringRef(y.name);527 }528 static bool isEqual(const Fortran::evaluate::TypeParamInquiry &x,529 const Fortran::evaluate::TypeParamInquiry &y) {530 return isEqual(x.base(), y.base()) && isEqual(x.parameter(), y.parameter());531 }532 static bool isEqual(const Fortran::evaluate::DescriptorInquiry &x,533 const Fortran::evaluate::DescriptorInquiry &y) {534 return isEqual(x.base(), y.base()) && x.field() == y.field() &&535 x.dimension() == y.dimension();536 }537 static bool isEqual(const Fortran::evaluate::StructureConstructor &x,538 const Fortran::evaluate::StructureConstructor &y) {539 const auto &xValues = x.values();540 const auto &yValues = y.values();541 if (xValues.size() != yValues.size())542 return false;543 if (x.derivedTypeSpec() != y.derivedTypeSpec())544 return false;545 for (const auto &[xSymbol, xValue] : xValues) {546 auto yIt = yValues.find(xSymbol);547 // This should probably never happen, since the derived type548 // should be the same.549 if (yIt == yValues.end())550 return false;551 if (!isEqual(xValue, yIt->second))552 return false;553 }554 return true;555 }556 template <int KIND>557 static bool isEqual(const Fortran::evaluate::Not<KIND> &x,558 const Fortran::evaluate::Not<KIND> &y) {559 return isEqual(x.left(), y.left());560 }561 template <int KIND>562 static bool isEqual(const Fortran::evaluate::LogicalOperation<KIND> &x,563 const Fortran::evaluate::LogicalOperation<KIND> &y) {564 return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());565 }566 template <typename A>567 static bool isEqual(const Fortran::evaluate::Relational<A> &x,568 const Fortran::evaluate::Relational<A> &y) {569 return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());570 }571 template <typename A>572 static bool isEqual(const Fortran::evaluate::Expr<A> &x,573 const Fortran::evaluate::Expr<A> &y) {574 return Fortran::common::visit(575 [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);576 }577 static bool578 isEqual(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x,579 const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &y) {580 return Fortran::common::visit(581 [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);582 }583 template <typename A>584 static bool isEqual(const Fortran::evaluate::Designator<A> &x,585 const Fortran::evaluate::Designator<A> &y) {586 return Fortran::common::visit(587 [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);588 }589 template <int BITS>590 static bool isEqual(const Fortran::evaluate::value::Integer<BITS> &x,591 const Fortran::evaluate::value::Integer<BITS> &y) {592 return x == y;593 }594 static bool isEqual(const Fortran::evaluate::NullPointer &x,595 const Fortran::evaluate::NullPointer &y) {596 return true;597 }598 template <typename A, typename B,599 std::enable_if_t<!std::is_same_v<A, B>, bool> = true>600 static bool isEqual(const A &, const B &) {601 return false;602 }603};604 605unsigned getHashValue(const Fortran::lower::SomeExpr *x) {606 return HashEvaluateExpr::getHashValue(*x);607}608 609unsigned getHashValue(const Fortran::lower::ExplicitIterSpace::ArrayBases &x) {610 return Fortran::common::visit(611 [&](const auto *p) { return HashEvaluateExpr::getHashValue(*p); }, x);612}613 614bool isEqual(const Fortran::lower::SomeExpr *x,615 const Fortran::lower::SomeExpr *y) {616 const auto *empty =617 llvm::DenseMapInfo<const Fortran::lower::SomeExpr *>::getEmptyKey();618 const auto *tombstone =619 llvm::DenseMapInfo<const Fortran::lower::SomeExpr *>::getTombstoneKey();620 if (x == empty || y == empty || x == tombstone || y == tombstone)621 return x == y;622 return x == y || IsEqualEvaluateExpr::isEqual(*x, *y);623}624 625bool isEqual(const Fortran::lower::ExplicitIterSpace::ArrayBases &x,626 const Fortran::lower::ExplicitIterSpace::ArrayBases &y) {627 return Fortran::common::visit(628 Fortran::common::visitors{629 // Fortran::semantics::Symbol * are the exception here. These pointers630 // have identity; if two Symbol * values are the same (different) then631 // they are the same (different) logical symbol.632 [&](Fortran::lower::FrontEndSymbol p,633 Fortran::lower::FrontEndSymbol q) { return p == q; },634 [&](const auto *p, const auto *q) {635 if constexpr (std::is_same_v<decltype(p), decltype(q)>) {636 return IsEqualEvaluateExpr::isEqual(*p, *q);637 } else {638 // Different subtree types are never equal.639 return false;640 }641 }},642 x, y);643}644 645void copyFirstPrivateSymbol(lower::AbstractConverter &converter,646 const semantics::Symbol *sym,647 mlir::OpBuilder::InsertPoint *copyAssignIP) {648 if (sym->test(semantics::Symbol::Flag::OmpFirstPrivate) ||649 sym->test(semantics::Symbol::Flag::LocalityLocalInit))650 converter.copyHostAssociateVar(*sym, copyAssignIP);651}652 653template <typename OpType, typename OperandsStructType>654void privatizeSymbol(655 lower::AbstractConverter &converter, fir::FirOpBuilder &firOpBuilder,656 lower::SymMap &symTable,657 llvm::SetVector<const semantics::Symbol *> &allPrivatizedSymbols,658 llvm::SmallPtrSet<const semantics::Symbol *, 16> &mightHaveReadHostSym,659 const semantics::Symbol *symToPrivatize, OperandsStructType *clauseOps,660 std::optional<llvm::omp::Directive> dir) {661 constexpr bool isDoConcurrent =662 std::is_same_v<OpType, fir::LocalitySpecifierOp>;663 mlir::OpBuilder::InsertPoint dcIP;664 665 if (isDoConcurrent) {666 dcIP = firOpBuilder.saveInsertionPoint();667 firOpBuilder.setInsertionPoint(668 firOpBuilder.getRegion().getParentOfType<fir::DoConcurrentOp>());669 }670 671 const semantics::Symbol *sym =672 isDoConcurrent ? &symToPrivatize->GetUltimate() : symToPrivatize;673 const lower::SymbolBox hsb = converter.lookupOneLevelUpSymbol(*sym);674 assert(hsb && "Host symbol box not found");675 676 mlir::Location symLoc = hsb.getAddr().getLoc();677 std::string privatizerName = sym->name().ToString() + ".privatizer";678 bool emitCopyRegion =679 symToPrivatize->test(semantics::Symbol::Flag::OmpFirstPrivate) ||680 symToPrivatize->test(semantics::Symbol::Flag::LocalityLocalInit);681 // A symbol attached to the simd directive can have the firstprivate flag set682 // on it when it is also used in a non-firstprivate privatization clause.683 // For instance: $omp do simd lastprivate(a) firstprivate(a)684 // We cannot apply the firstprivate privatizer to simd, so make sure we do685 // not emit the copy region when dealing with the SIMD directive.686 if (dir && dir == llvm::omp::Directive::OMPD_simd)687 emitCopyRegion = false;688 689 mlir::Value privVal = hsb.getAddr();690 mlir::Type allocType = privVal.getType();691 if (!mlir::isa<fir::PointerType>(privVal.getType()))692 allocType = fir::unwrapRefType(privVal.getType());693 694 if (auto poly = mlir::dyn_cast<fir::ClassType>(allocType)) {695 if (!mlir::isa<fir::PointerType>(poly.getEleTy()) && emitCopyRegion)696 TODO(symLoc, "create polymorphic host associated copy");697 }698 699 // fir.array<> cannot be converted to any single llvm type and fir helpers700 // are not available in openmp to llvmir translation so we cannot generate701 // an alloca for a fir.array type there. Get around this by boxing all702 // arrays.703 if (mlir::isa<fir::SequenceType>(allocType)) {704 hlfir::Entity entity{hsb.getAddr()};705 entity = genVariableBox(symLoc, firOpBuilder, entity);706 privVal = entity.getBase();707 allocType = privVal.getType();708 }709 710 if (mlir::isa<fir::BaseBoxType>(privVal.getType())) {711 // Boxes should be passed by reference into nested regions:712 auto oldIP = firOpBuilder.saveInsertionPoint();713 firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());714 auto alloca =715 fir::AllocaOp::create(firOpBuilder, symLoc, privVal.getType());716 firOpBuilder.restoreInsertionPoint(oldIP);717 fir::StoreOp::create(firOpBuilder, symLoc, privVal, alloca);718 privVal = alloca;719 }720 721 mlir::Type argType = privVal.getType();722 723 OpType privatizerOp = [&]() {724 auto moduleOp = firOpBuilder.getModule();725 auto uniquePrivatizerName = fir::getTypeAsString(726 allocType, converter.getKindMap(),727 converter.mangleName(*sym) +728 (emitCopyRegion ? "_firstprivate" : "_private"));729 730 if (auto existingPrivatizer =731 moduleOp.lookupSymbol<OpType>(uniquePrivatizerName))732 return existingPrivatizer;733 734 mlir::OpBuilder::InsertionGuard guard(firOpBuilder);735 firOpBuilder.setInsertionPointToStart(moduleOp.getBody());736 OpType result;737 738 if constexpr (std::is_same_v<OpType, mlir::omp::PrivateClauseOp>) {739 result = OpType::create(740 firOpBuilder, symLoc, uniquePrivatizerName, allocType,741 emitCopyRegion ? mlir::omp::DataSharingClauseType::FirstPrivate742 : mlir::omp::DataSharingClauseType::Private);743 } else {744 result =745 OpType::create(firOpBuilder, symLoc, uniquePrivatizerName, allocType,746 emitCopyRegion ? fir::LocalitySpecifierType::LocalInit747 : fir::LocalitySpecifierType::Local);748 }749 750 fir::ExtendedValue symExV = converter.getSymbolExtendedValue(*sym);751 lower::SymMapScope outerScope(symTable);752 753 // Populate the `init` region.754 // We need to initialize in the following cases:755 // 1. The allocation was for a derived type which requires initialization756 // (this can be skipped if it will be initialized anyway by the copy757 // region, unless the derived type has allocatable components)758 // 2. The allocation was for any kind of box759 // 3. The allocation was for a boxed character760 const bool needsInitialization =761 (Fortran::lower::hasDefaultInitialization(sym->GetUltimate()) &&762 (!emitCopyRegion || hlfir::mayHaveAllocatableComponent(allocType))) ||763 mlir::isa<fir::BaseBoxType>(allocType) ||764 mlir::isa<fir::BoxCharType>(allocType);765 if (needsInitialization) {766 lower::SymbolBox hsb = converter.lookupOneLevelUpSymbol(767 isDoConcurrent ? symToPrivatize->GetUltimate() : *symToPrivatize);768 769 assert(hsb && "Host symbol box not found");770 hlfir::Entity entity{hsb.getAddr()};771 bool cannotHaveNonDefaultLowerBounds =772 !entity.mayHaveNonDefaultLowerBounds();773 774 mlir::Region &initRegion = result.getInitRegion();775 mlir::Location symLoc = hsb.getAddr().getLoc();776 mlir::Block *initBlock = firOpBuilder.createBlock(777 &initRegion, /*insertPt=*/{}, {argType, argType}, {symLoc, symLoc});778 779 bool emitCopyRegion =780 symToPrivatize->test(semantics::Symbol::Flag::OmpFirstPrivate) ||781 symToPrivatize->test(782 Fortran::semantics::Symbol::Flag::LocalityLocalInit);783 784 populateByRefInitAndCleanupRegions(785 converter, symLoc, argType, /*scalarInitValue=*/nullptr, initBlock,786 result.getInitPrivateArg(), result.getInitMoldArg(),787 result.getDeallocRegion(),788 emitCopyRegion ? DeclOperationKind::FirstPrivateOrLocalInit789 : DeclOperationKind::PrivateOrLocal,790 symToPrivatize, cannotHaveNonDefaultLowerBounds, isDoConcurrent);791 // TODO: currently there are false positives from dead uses of the mold792 // arg793 if (result.initReadsFromMold())794 mightHaveReadHostSym.insert(symToPrivatize);795 }796 797 // Populate the `copy` region if this is a `firstprivate`.798 if (emitCopyRegion) {799 mlir::Region ©Region = result.getCopyRegion();800 // First block argument corresponding to the original/host value while801 // second block argument corresponding to the privatized value.802 mlir::Block *copyEntryBlock = firOpBuilder.createBlock(803 ©Region, /*insertPt=*/{}, {argType, argType}, {symLoc, symLoc});804 firOpBuilder.setInsertionPointToEnd(copyEntryBlock);805 806 auto addSymbol = [&](unsigned argIdx, const semantics::Symbol *symToMap,807 bool force = false) {808 symExV.match(809 [&](const fir::MutableBoxValue &box) {810 symTable.addSymbol(811 *symToMap,812 fir::substBase(box, copyRegion.getArgument(argIdx)), force);813 },814 [&](const auto &box) {815 symTable.addSymbol(*symToMap, copyRegion.getArgument(argIdx),816 force);817 });818 };819 820 addSymbol(0, sym, true);821 lower::SymMapScope innerScope(symTable);822 addSymbol(1, symToPrivatize);823 824 auto ip = firOpBuilder.saveInsertionPoint();825 copyFirstPrivateSymbol(converter, symToPrivatize, &ip);826 827 if constexpr (std::is_same_v<OpType, mlir::omp::PrivateClauseOp>) {828 mlir::omp::YieldOp::create(829 firOpBuilder, hsb.getAddr().getLoc(),830 symTable.shallowLookupSymbol(*symToPrivatize).getAddr());831 } else {832 fir::YieldOp::create(833 firOpBuilder, hsb.getAddr().getLoc(),834 symTable.shallowLookupSymbol(*symToPrivatize).getAddr());835 }836 }837 838 return result;839 }();840 841 if (clauseOps) {842 clauseOps->privateSyms.push_back(mlir::SymbolRefAttr::get(privatizerOp));843 clauseOps->privateVars.push_back(privVal);844 }845 846 if (isDoConcurrent)847 allPrivatizedSymbols.insert(symToPrivatize);848 849 if (isDoConcurrent)850 firOpBuilder.restoreInsertionPoint(dcIP);851}852 853template void854privatizeSymbol<mlir::omp::PrivateClauseOp, mlir::omp::PrivateClauseOps>(855 lower::AbstractConverter &converter, fir::FirOpBuilder &firOpBuilder,856 lower::SymMap &symTable,857 llvm::SetVector<const semantics::Symbol *> &allPrivatizedSymbols,858 llvm::SmallPtrSet<const semantics::Symbol *, 16> &mightHaveReadHostSym,859 const semantics::Symbol *symToPrivatize,860 mlir::omp::PrivateClauseOps *clauseOps,861 std::optional<llvm::omp::Directive> dir);862 863template void864privatizeSymbol<fir::LocalitySpecifierOp, fir::LocalitySpecifierOperands>(865 lower::AbstractConverter &converter, fir::FirOpBuilder &firOpBuilder,866 lower::SymMap &symTable,867 llvm::SetVector<const semantics::Symbol *> &allPrivatizedSymbols,868 llvm::SmallPtrSet<const semantics::Symbol *, 16> &mightHaveReadHostSym,869 const semantics::Symbol *symToPrivatize,870 fir::LocalitySpecifierOperands *clauseOps,871 std::optional<llvm::omp::Directive> dir);872 873} // end namespace Fortran::lower874