1 //===-- HostAssociations.cpp ----------------------------------------------===// 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-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "flang/Lower/HostAssociations.h" 10 #include "flang/Evaluate/check-expression.h" 11 #include "flang/Lower/AbstractConverter.h" 12 #include "flang/Lower/Allocatable.h" 13 #include "flang/Lower/BoxAnalyzer.h" 14 #include "flang/Lower/CallInterface.h" 15 #include "flang/Lower/ConvertType.h" 16 #include "flang/Lower/PFTBuilder.h" 17 #include "flang/Lower/SymbolMap.h" 18 #include "flang/Lower/Todo.h" 19 #include "flang/Optimizer/Builder/Character.h" 20 #include "flang/Optimizer/Builder/FIRBuilder.h" 21 #include "flang/Optimizer/Support/FatalError.h" 22 #include "flang/Semantics/tools.h" 23 #include "llvm/ADT/TypeSwitch.h" 24 #include "llvm/Support/Debug.h" 25 26 #define DEBUG_TYPE "flang-host-assoc" 27 28 // Host association inside internal procedures is implemented by allocating an 29 // mlir tuple (a struct) inside the host containing the addresses and properties 30 // of variables that are accessed by internal procedures. The address of this 31 // tuple is passed as an argument by the host when calling internal procedures. 32 // Internal procedures propagate a reference to this tuple when calling other 33 // internal procedures of the host. 34 // 35 // This file defines how the type of the host tuple is built, how the tuple 36 // value is created inside the host, and how the host associated variables are 37 // instantiated inside the internal procedures from the tuple value. The 38 // CapturedXXX classes define each of these three actions for a specific 39 // kind of variables by providing a `getType`, a `instantiateHostTuple`, and a 40 // `getFromTuple` method. These classes are structured as follow: 41 // 42 // class CapturedKindOfVar : public CapturedSymbols<CapturedKindOfVar> { 43 // // Return the type of the tuple element for a host associated 44 // // variable given its symbol inside the host. This is called when 45 // // building function interfaces. 46 // static mlir::Type getType(); 47 // // Build the tuple element value for a host associated variable given its 48 // // value inside the host. This is called when lowering the host body. 49 // static void instantiateHostTuple(); 50 // // Instantiate a host variable inside an internal procedure given its 51 // // tuple element value. This is called when lowering internal procedure 52 // // bodies. 53 // static void getFromTuple(); 54 // }; 55 // 56 // If a new kind of variable requires ad-hoc handling, a new CapturedXXX class 57 // should be added to handle it, and `walkCaptureCategories` should be updated 58 // to dispatch this new kind of variable to this new class. 59 60 /// Struct to be used as argument in walkCaptureCategories when building the 61 /// tuple element type for a host associated variable. 62 struct GetTypeInTuple { 63 /// walkCaptureCategories must return a type. 64 using Result = mlir::Type; 65 }; 66 67 /// Struct to be used as argument in walkCaptureCategories when building the 68 /// tuple element value for a host associated variable. 69 struct InstantiateHostTuple { 70 /// walkCaptureCategories returns nothing. 71 using Result = void; 72 /// Value of the variable inside the host procedure. 73 fir::ExtendedValue hostValue; 74 /// Address of the tuple element of the variable. 75 mlir::Value addrInTuple; 76 mlir::Location loc; 77 }; 78 79 /// Struct to be used as argument in walkCaptureCategories when instantiating a 80 /// host associated variables from its tuple element value. 81 struct GetFromTuple { 82 /// walkCaptureCategories returns nothing. 83 using Result = void; 84 /// Symbol map inside the internal procedure. 85 Fortran::lower::SymMap &symMap; 86 /// Value of the tuple element for the host associated variable. 87 mlir::Value valueInTuple; 88 mlir::Location loc; 89 }; 90 91 /// Base class that must be inherited with CRTP by classes defining 92 /// how host association is implemented for a type of symbol. 93 /// It simply dispatches visit() calls to the implementations according 94 /// to the argument type. 95 template <typename SymbolCategory> 96 class CapturedSymbols { 97 public: 98 template <typename T> 99 static void visit(const T &, Fortran::lower::AbstractConverter &, 100 const Fortran::semantics::Symbol &, 101 const Fortran::lower::BoxAnalyzer &) { 102 static_assert(!std::is_same_v<T, T> && 103 "default visit must not be instantiated"); 104 } 105 static mlir::Type visit(const GetTypeInTuple &, 106 Fortran::lower::AbstractConverter &converter, 107 const Fortran::semantics::Symbol &sym, 108 const Fortran::lower::BoxAnalyzer &) { 109 return SymbolCategory::getType(converter, sym); 110 } 111 static void visit(const InstantiateHostTuple &args, 112 Fortran::lower::AbstractConverter &converter, 113 const Fortran::semantics::Symbol &sym, 114 const Fortran::lower::BoxAnalyzer &) { 115 return SymbolCategory::instantiateHostTuple(args, converter, sym); 116 } 117 static void visit(const GetFromTuple &args, 118 Fortran::lower::AbstractConverter &converter, 119 const Fortran::semantics::Symbol &sym, 120 const Fortran::lower::BoxAnalyzer &ba) { 121 return SymbolCategory::getFromTuple(args, converter, sym, ba); 122 } 123 }; 124 125 /// Class defining simple scalars are captured in internal procedures. 126 /// Simple scalars are non character intrinsic scalars. They are captured 127 /// as `!fir.ref<T>`, for example `!fir.ref<i32>` for `INTEGER*4`. 128 class CapturedSimpleScalars : public CapturedSymbols<CapturedSimpleScalars> { 129 public: 130 static mlir::Type getType(Fortran::lower::AbstractConverter &converter, 131 const Fortran::semantics::Symbol &sym) { 132 return fir::ReferenceType::get(converter.genType(sym)); 133 } 134 135 static void instantiateHostTuple(const InstantiateHostTuple &args, 136 Fortran::lower::AbstractConverter &converter, 137 const Fortran::semantics::Symbol &) { 138 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 139 mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType()); 140 assert(typeInTuple && "addrInTuple must be an address"); 141 mlir::Value castBox = builder.createConvert(args.loc, typeInTuple, 142 fir::getBase(args.hostValue)); 143 builder.create<fir::StoreOp>(args.loc, castBox, args.addrInTuple); 144 } 145 146 static void getFromTuple(const GetFromTuple &args, 147 Fortran::lower::AbstractConverter &, 148 const Fortran::semantics::Symbol &sym, 149 const Fortran::lower::BoxAnalyzer &) { 150 args.symMap.addSymbol(sym, args.valueInTuple); 151 } 152 }; 153 154 /// Class defining how dummy procedures and procedure pointers 155 /// are captured in internal procedures. 156 class CapturedProcedure : public CapturedSymbols<CapturedProcedure> { 157 public: 158 static mlir::Type getType(Fortran::lower::AbstractConverter &converter, 159 const Fortran::semantics::Symbol &sym) { 160 if (Fortran::semantics::IsPointer(sym)) 161 TODO(converter.getCurrentLocation(), 162 "capture procedure pointer in internal procedure"); 163 return Fortran::lower::getDummyProcedureType(sym, converter); 164 } 165 166 static void instantiateHostTuple(const InstantiateHostTuple &args, 167 Fortran::lower::AbstractConverter &converter, 168 const Fortran::semantics::Symbol &) { 169 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 170 mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType()); 171 assert(typeInTuple && "addrInTuple must be an address"); 172 mlir::Value castBox = builder.createConvert(args.loc, typeInTuple, 173 fir::getBase(args.hostValue)); 174 builder.create<fir::StoreOp>(args.loc, castBox, args.addrInTuple); 175 } 176 177 static void getFromTuple(const GetFromTuple &args, 178 Fortran::lower::AbstractConverter &, 179 const Fortran::semantics::Symbol &sym, 180 const Fortran::lower::BoxAnalyzer &) { 181 args.symMap.addSymbol(sym, args.valueInTuple); 182 } 183 }; 184 185 /// Class defining how character scalars are captured in internal procedures. 186 /// Character scalars are passed as !fir.boxchar<kind> in the tuple. 187 class CapturedCharacterScalars 188 : public CapturedSymbols<CapturedCharacterScalars> { 189 public: 190 // Note: so far, do not specialize constant length characters. They can be 191 // implemented by only passing the address. This could be done later in 192 // lowering or a CapturedStaticLenCharacterScalars class could be added here. 193 194 static mlir::Type getType(Fortran::lower::AbstractConverter &converter, 195 const Fortran::semantics::Symbol &sym) { 196 fir::KindTy kind = 197 converter.genType(sym).cast<fir::CharacterType>().getFKind(); 198 return fir::BoxCharType::get(&converter.getMLIRContext(), kind); 199 } 200 201 static void instantiateHostTuple(const InstantiateHostTuple &args, 202 Fortran::lower::AbstractConverter &converter, 203 const Fortran::semantics::Symbol &) { 204 const fir::CharBoxValue *charBox = args.hostValue.getCharBox(); 205 assert(charBox && "host value must be a fir::CharBoxValue"); 206 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 207 mlir::Value boxchar = fir::factory::CharacterExprHelper(builder, args.loc) 208 .createEmbox(*charBox); 209 builder.create<fir::StoreOp>(args.loc, boxchar, args.addrInTuple); 210 } 211 212 static void getFromTuple(const GetFromTuple &args, 213 Fortran::lower::AbstractConverter &converter, 214 const Fortran::semantics::Symbol &sym, 215 const Fortran::lower::BoxAnalyzer &) { 216 fir::factory::CharacterExprHelper charHelp(converter.getFirOpBuilder(), 217 args.loc); 218 std::pair<mlir::Value, mlir::Value> unboxchar = 219 charHelp.createUnboxChar(args.valueInTuple); 220 args.symMap.addCharSymbol(sym, unboxchar.first, unboxchar.second); 221 } 222 }; 223 224 /// Is \p sym a derived type entity with length parameters ? 225 static bool 226 isDerivedWithLengthParameters(const Fortran::semantics::Symbol &sym) { 227 if (const auto *declTy = sym.GetType()) 228 if (const auto *derived = declTy->AsDerived()) 229 return Fortran::semantics::CountLenParameters(*derived) != 0; 230 return false; 231 } 232 233 /// Class defining how allocatable and pointers entities are captured in 234 /// internal procedures. Allocatable and pointers are simply captured by placing 235 /// their !fir.ref<fir.box<>> address in the host tuple. 236 class CapturedAllocatableAndPointer 237 : public CapturedSymbols<CapturedAllocatableAndPointer> { 238 public: 239 static mlir::Type getType(Fortran::lower::AbstractConverter &converter, 240 const Fortran::semantics::Symbol &sym) { 241 return fir::ReferenceType::get(converter.genType(sym)); 242 } 243 static void instantiateHostTuple(const InstantiateHostTuple &args, 244 Fortran::lower::AbstractConverter &converter, 245 const Fortran::semantics::Symbol &) { 246 assert(args.hostValue.getBoxOf<fir::MutableBoxValue>() && 247 "host value must be a fir::MutableBoxValue"); 248 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 249 mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType()); 250 assert(typeInTuple && "addrInTuple must be an address"); 251 mlir::Value castBox = builder.createConvert(args.loc, typeInTuple, 252 fir::getBase(args.hostValue)); 253 builder.create<fir::StoreOp>(args.loc, castBox, args.addrInTuple); 254 } 255 static void getFromTuple(const GetFromTuple &args, 256 Fortran::lower::AbstractConverter &converter, 257 const Fortran::semantics::Symbol &sym, 258 const Fortran::lower::BoxAnalyzer &ba) { 259 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 260 mlir::Location loc = args.loc; 261 // Non deferred type parameters impact the semantics of some statements 262 // where allocatables/pointer can appear. For instance, assignment to a 263 // scalar character allocatable with has a different semantics in F2003 and 264 // later if the length is non deferred vs when it is deferred. So it is 265 // important to keep track of the non deferred parameters here. 266 llvm::SmallVector<mlir::Value> nonDeferredLenParams; 267 if (ba.isChar()) { 268 mlir::IndexType idxTy = builder.getIndexType(); 269 if (llvm::Optional<int64_t> len = ba.getCharLenConst()) { 270 nonDeferredLenParams.push_back( 271 builder.createIntegerConstant(loc, idxTy, *len)); 272 } else if (Fortran::semantics::IsAssumedLengthCharacter(sym) || 273 ba.getCharLenExpr()) { 274 // Read length from fir.box (explicit expr cannot safely be re-evaluated 275 // here). 276 auto readLength = [&]() { 277 fir::BoxValue boxLoad = 278 builder.create<fir::LoadOp>(loc, fir::getBase(args.valueInTuple)) 279 .getResult(); 280 return fir::factory::readCharLen(builder, loc, boxLoad); 281 }; 282 if (Fortran::semantics::IsOptional(sym)) { 283 // It is not safe to unconditionally read boxes of optionals in case 284 // they are absents. According to 15.5.2.12 3 (9), it is illegal to 285 // inquire the length of absent optional, even if non deferred, so 286 // it's fine to use undefOp in this case. 287 auto isPresent = builder.create<fir::IsPresentOp>( 288 loc, builder.getI1Type(), fir::getBase(args.valueInTuple)); 289 mlir::Value len = 290 builder.genIfOp(loc, {idxTy}, isPresent, true) 291 .genThen([&]() { 292 builder.create<fir::ResultOp>(loc, readLength()); 293 }) 294 .genElse([&]() { 295 auto undef = builder.create<fir::UndefOp>(loc, idxTy); 296 builder.create<fir::ResultOp>(loc, undef.getResult()); 297 }) 298 .getResults()[0]; 299 nonDeferredLenParams.push_back(len); 300 } else { 301 nonDeferredLenParams.push_back(readLength()); 302 } 303 } 304 } else if (isDerivedWithLengthParameters(sym)) { 305 TODO(loc, "host associated derived type allocatable or pointer with " 306 "length parameters"); 307 } 308 args.symMap.addSymbol( 309 sym, fir::MutableBoxValue(args.valueInTuple, nonDeferredLenParams, {})); 310 } 311 }; 312 313 /// Class defining how arrays are captured inside internal procedures. 314 /// Array are captured via a `fir.box<fir.array<T>>` descriptor that belongs to 315 /// the host tuple. This allows capturing lower bounds, which can be done by 316 /// providing a ShapeShiftOp argument to the EmboxOp. 317 class CapturedArrays : public CapturedSymbols<CapturedArrays> { 318 319 // Note: Constant shape arrays are not specialized (their base address would 320 // be sufficient information inside the tuple). They could be specialized in 321 // a later FIR pass, or a CapturedStaticShapeArrays could be added to deal 322 // with them here. 323 public: 324 static mlir::Type getType(Fortran::lower::AbstractConverter &converter, 325 const Fortran::semantics::Symbol &sym) { 326 mlir::Type type = converter.genType(sym); 327 assert(type.isa<fir::SequenceType>() && "must be a sequence type"); 328 return fir::BoxType::get(type); 329 } 330 331 static void instantiateHostTuple(const InstantiateHostTuple &args, 332 Fortran::lower::AbstractConverter &converter, 333 const Fortran::semantics::Symbol &sym) { 334 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 335 mlir::Location loc = args.loc; 336 fir::MutableBoxValue boxInTuple(args.addrInTuple, {}, {}); 337 if (args.hostValue.getBoxOf<fir::BoxValue>() && 338 Fortran::semantics::IsOptional(sym)) { 339 // The assumed shape optional case need some care because it is illegal to 340 // read the incoming box if it is absent (this would cause segfaults). 341 // Pointer association requires reading the target box, so it can only be 342 // done on present optional. For absent optionals, simply create a 343 // disassociated pointer (it is illegal to inquire about lower bounds or 344 // lengths of optional according to 15.5.2.12 3 (9) and 10.1.11 2 (7)b). 345 auto isPresent = builder.create<fir::IsPresentOp>( 346 loc, builder.getI1Type(), fir::getBase(args.hostValue)); 347 builder.genIfThenElse(loc, isPresent) 348 .genThen([&]() { 349 fir::factory::associateMutableBox(builder, loc, boxInTuple, 350 args.hostValue, 351 /*lbounds=*/llvm::None); 352 }) 353 .genElse([&]() { 354 fir::factory::disassociateMutableBox(builder, loc, boxInTuple); 355 }) 356 .end(); 357 } else { 358 fir::factory::associateMutableBox(builder, loc, boxInTuple, 359 args.hostValue, /*lbounds=*/llvm::None); 360 } 361 } 362 363 static void getFromTuple(const GetFromTuple &args, 364 Fortran::lower::AbstractConverter &converter, 365 const Fortran::semantics::Symbol &sym, 366 const Fortran::lower::BoxAnalyzer &ba) { 367 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 368 mlir::Location loc = args.loc; 369 mlir::Value box = args.valueInTuple; 370 mlir::IndexType idxTy = builder.getIndexType(); 371 llvm::SmallVector<mlir::Value> lbounds; 372 if (!ba.lboundIsAllOnes()) { 373 if (ba.isStaticArray()) { 374 for (std::int64_t lb : ba.staticLBound()) 375 lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, lb)); 376 } else { 377 // Cannot re-evaluate specification expressions here. 378 // Operands values may have changed. Get value from fir.box 379 const unsigned rank = sym.Rank(); 380 for (unsigned dim = 0; dim < rank; ++dim) { 381 mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim); 382 auto dims = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, 383 box, dimVal); 384 lbounds.emplace_back(dims.getResult(0)); 385 } 386 } 387 } 388 389 if (canReadCapturedBoxValue(converter, sym)) { 390 fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/llvm::None); 391 args.symMap.addSymbol(sym, 392 fir::factory::readBoxValue(builder, loc, boxValue)); 393 } else { 394 // Keep variable as a fir.box. 395 // If this is an optional that is absent, the fir.box needs to be an 396 // AbsentOp result, otherwise it will not work properly with IsPresentOp 397 // (absent boxes are null descriptor addresses, not descriptors containing 398 // a null base address). 399 if (Fortran::semantics::IsOptional(sym)) { 400 auto boxTy = box.getType().cast<fir::BoxType>(); 401 auto eleTy = boxTy.getEleTy(); 402 if (!fir::isa_ref_type(eleTy)) 403 eleTy = builder.getRefType(eleTy); 404 auto addr = builder.create<fir::BoxAddrOp>(loc, eleTy, box); 405 mlir::Value isPresent = builder.genIsNotNull(loc, addr); 406 auto absentBox = builder.create<fir::AbsentOp>(loc, boxTy); 407 box = builder.create<mlir::arith::SelectOp>(loc, isPresent, box, 408 absentBox); 409 } 410 fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/llvm::None); 411 args.symMap.addSymbol(sym, boxValue); 412 } 413 } 414 415 private: 416 /// Can the fir.box from the host link be read into simpler values ? 417 /// Later, without the symbol information, it might not be possible 418 /// to tell if the fir::BoxValue from the host link is contiguous. 419 static bool 420 canReadCapturedBoxValue(Fortran::lower::AbstractConverter &converter, 421 const Fortran::semantics::Symbol &sym) { 422 bool isScalarOrContiguous = 423 sym.Rank() == 0 || Fortran::evaluate::IsSimplyContiguous( 424 Fortran::evaluate::AsGenericExpr(sym).value(), 425 converter.getFoldingContext()); 426 const Fortran::semantics::DeclTypeSpec *type = sym.GetType(); 427 bool isPolymorphic = type && type->IsPolymorphic(); 428 return isScalarOrContiguous && !isPolymorphic && 429 !isDerivedWithLengthParameters(sym); 430 } 431 }; 432 433 /// Dispatch \p visitor to the CapturedSymbols which is handling how host 434 /// association is implemented for this kind of symbols. This ensures the same 435 /// dispatch decision is taken when building the tuple type, when creating the 436 /// tuple, and when instantiating host associated variables from it. 437 template <typename T> 438 typename T::Result 439 walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter, 440 const Fortran::semantics::Symbol &sym) { 441 if (isDerivedWithLengthParameters(sym)) 442 // Should be boxed. 443 TODO(converter.genLocation(sym.name()), 444 "host associated derived type with length parameters"); 445 Fortran::lower::BoxAnalyzer ba; 446 // Do not analyze procedures, they may be subroutines with no types that would 447 // crash the analysis. 448 if (Fortran::semantics::IsProcedure(sym)) 449 return CapturedProcedure::visit(visitor, converter, sym, ba); 450 ba.analyze(sym); 451 if (Fortran::evaluate::IsAllocatableOrPointer(sym)) 452 return CapturedAllocatableAndPointer::visit(visitor, converter, sym, ba); 453 if (ba.isArray()) 454 return CapturedArrays::visit(visitor, converter, sym, ba); 455 if (ba.isChar()) 456 return CapturedCharacterScalars::visit(visitor, converter, sym, ba); 457 assert(ba.isTrivial() && "must be trivial scalar"); 458 return CapturedSimpleScalars::visit(visitor, converter, sym, ba); 459 } 460 461 // `t` should be the result of getArgumentType, which has a type of 462 // `!fir.ref<tuple<...>>`. 463 static mlir::TupleType unwrapTupleTy(mlir::Type t) { 464 return fir::dyn_cast_ptrEleTy(t).cast<mlir::TupleType>(); 465 } 466 467 static mlir::Value genTupleCoor(fir::FirOpBuilder &builder, mlir::Location loc, 468 mlir::Type varTy, mlir::Value tupleArg, 469 mlir::Value offset) { 470 // fir.ref<fir.ref> and fir.ptr<fir.ref> are forbidden. Use 471 // fir.llvm_ptr if needed. 472 auto ty = varTy.isa<fir::ReferenceType>() 473 ? mlir::Type(fir::LLVMPointerType::get(varTy)) 474 : mlir::Type(builder.getRefType(varTy)); 475 return builder.create<fir::CoordinateOp>(loc, ty, tupleArg, offset); 476 } 477 478 void Fortran::lower::HostAssociations::hostProcedureBindings( 479 Fortran::lower::AbstractConverter &converter, 480 Fortran::lower::SymMap &symMap) { 481 if (symbols.empty()) 482 return; 483 484 // Create the tuple variable. 485 mlir::TupleType tupTy = unwrapTupleTy(getArgumentType(converter)); 486 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 487 mlir::Location loc = converter.getCurrentLocation(); 488 auto hostTuple = builder.create<fir::AllocaOp>(loc, tupTy); 489 mlir::IntegerType offTy = builder.getIntegerType(32); 490 491 // Walk the list of symbols and update the pointers in the tuple. 492 for (auto s : llvm::enumerate(symbols)) { 493 auto indexInTuple = s.index(); 494 mlir::Value off = builder.createIntegerConstant(loc, offTy, indexInTuple); 495 mlir::Type varTy = tupTy.getType(indexInTuple); 496 mlir::Value eleOff = genTupleCoor(builder, loc, varTy, hostTuple, off); 497 InstantiateHostTuple instantiateHostTuple{ 498 symMap.lookupSymbol(s.value()).toExtendedValue(), eleOff, loc}; 499 walkCaptureCategories(instantiateHostTuple, converter, *s.value()); 500 } 501 502 converter.bindHostAssocTuple(hostTuple); 503 } 504 505 void Fortran::lower::HostAssociations::internalProcedureBindings( 506 Fortran::lower::AbstractConverter &converter, 507 Fortran::lower::SymMap &symMap) { 508 if (symbols.empty()) 509 return; 510 511 // Find the argument with the tuple type. The argument ought to be appended. 512 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 513 mlir::Type argTy = getArgumentType(converter); 514 mlir::TupleType tupTy = unwrapTupleTy(argTy); 515 mlir::Location loc = converter.getCurrentLocation(); 516 mlir::FuncOp func = builder.getFunction(); 517 mlir::Value tupleArg; 518 for (auto [ty, arg] : llvm::reverse( 519 llvm::zip(func.getType().getInputs(), func.front().getArguments()))) 520 if (ty == argTy) { 521 tupleArg = arg; 522 break; 523 } 524 if (!tupleArg) 525 fir::emitFatalError(loc, "no host association argument found"); 526 527 converter.bindHostAssocTuple(tupleArg); 528 529 mlir::IntegerType offTy = builder.getIntegerType(32); 530 531 // Walk the list and add the bindings to the symbol table. 532 for (auto s : llvm::enumerate(symbols)) { 533 mlir::Value off = builder.createIntegerConstant(loc, offTy, s.index()); 534 mlir::Type varTy = tupTy.getType(s.index()); 535 mlir::Value eleOff = genTupleCoor(builder, loc, varTy, tupleArg, off); 536 mlir::Value valueInTuple = builder.create<fir::LoadOp>(loc, eleOff); 537 GetFromTuple getFromTuple{symMap, valueInTuple, loc}; 538 walkCaptureCategories(getFromTuple, converter, *s.value()); 539 } 540 } 541 542 mlir::Type Fortran::lower::HostAssociations::getArgumentType( 543 Fortran::lower::AbstractConverter &converter) { 544 if (symbols.empty()) 545 return {}; 546 if (argType) 547 return argType; 548 549 // Walk the list of Symbols and create their types. Wrap them in a reference 550 // to a tuple. 551 mlir::MLIRContext *ctxt = &converter.getMLIRContext(); 552 llvm::SmallVector<mlir::Type> tupleTys; 553 for (const Fortran::semantics::Symbol *sym : symbols) 554 tupleTys.emplace_back( 555 walkCaptureCategories(GetTypeInTuple{}, converter, *sym)); 556 argType = fir::ReferenceType::get(mlir::TupleType::get(ctxt, tupleTys)); 557 return argType; 558 } 559