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