1 //===-- lib/Evaluate/characteristics.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/Evaluate/characteristics.h"
10 #include "flang/Common/indirection.h"
11 #include "flang/Evaluate/check-expression.h"
12 #include "flang/Evaluate/fold.h"
13 #include "flang/Evaluate/intrinsics.h"
14 #include "flang/Evaluate/tools.h"
15 #include "flang/Evaluate/type.h"
16 #include "flang/Parser/message.h"
17 #include "flang/Semantics/scope.h"
18 #include "flang/Semantics/symbol.h"
19 #include "llvm/Support/raw_ostream.h"
20 #include <initializer_list>
21 
22 using namespace Fortran::parser::literals;
23 
24 namespace Fortran::evaluate::characteristics {
25 
26 // Copy attributes from a symbol to dst based on the mapping in pairs.
27 template <typename A, typename B>
28 static void CopyAttrs(const semantics::Symbol &src, A &dst,
29     const std::initializer_list<std::pair<semantics::Attr, B>> &pairs) {
30   for (const auto &pair : pairs) {
31     if (src.attrs().test(pair.first)) {
32       dst.attrs.set(pair.second);
33     }
34   }
35 }
36 
37 // Shapes of function results and dummy arguments have to have
38 // the same rank, the same deferred dimensions, and the same
39 // values for explicit dimensions when constant.
40 bool ShapesAreCompatible(const Shape &x, const Shape &y) {
41   if (x.size() != y.size()) {
42     return false;
43   }
44   auto yIter{y.begin()};
45   for (const auto &xDim : x) {
46     const auto &yDim{*yIter++};
47     if (xDim) {
48       if (!yDim || ToInt64(*xDim) != ToInt64(*yDim)) {
49         return false;
50       }
51     } else if (yDim) {
52       return false;
53     }
54   }
55   return true;
56 }
57 
58 bool TypeAndShape::operator==(const TypeAndShape &that) const {
59   return type_ == that.type_ && ShapesAreCompatible(shape_, that.shape_) &&
60       attrs_ == that.attrs_ && corank_ == that.corank_;
61 }
62 
63 TypeAndShape &TypeAndShape::Rewrite(FoldingContext &context) {
64   LEN_ = Fold(context, std::move(LEN_));
65   shape_ = Fold(context, std::move(shape_));
66   return *this;
67 }
68 
69 std::optional<TypeAndShape> TypeAndShape::Characterize(
70     const semantics::Symbol &symbol, FoldingContext &context) {
71   const auto &ultimate{symbol.GetUltimate()};
72   return common::visit(
73       common::visitors{
74           [&](const semantics::ProcEntityDetails &proc) {
75             const semantics::ProcInterface &interface { proc.interface() };
76             if (interface.type()) {
77               return Characterize(*interface.type(), context);
78             } else if (interface.symbol()) {
79               return Characterize(*interface.symbol(), context);
80             } else {
81               return std::optional<TypeAndShape>{};
82             }
83           },
84           [&](const semantics::AssocEntityDetails &assoc) {
85             return Characterize(assoc, context);
86           },
87           [&](const semantics::ProcBindingDetails &binding) {
88             return Characterize(binding.symbol(), context);
89           },
90           [&](const auto &x) -> std::optional<TypeAndShape> {
91             using Ty = std::decay_t<decltype(x)>;
92             if constexpr (std::is_same_v<Ty, semantics::EntityDetails> ||
93                 std::is_same_v<Ty, semantics::ObjectEntityDetails> ||
94                 std::is_same_v<Ty, semantics::TypeParamDetails>) {
95               if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
96                 if (auto dyType{DynamicType::From(*type)}) {
97                   TypeAndShape result{
98                       std::move(*dyType), GetShape(context, ultimate)};
99                   result.AcquireAttrs(ultimate);
100                   result.AcquireLEN(ultimate);
101                   return std::move(result.Rewrite(context));
102                 }
103               }
104             }
105             return std::nullopt;
106           },
107       },
108       // GetUltimate() used here, not ResolveAssociations(), because
109       // we need the type/rank of an associate entity from TYPE IS,
110       // CLASS IS, or RANK statement.
111       ultimate.details());
112 }
113 
114 std::optional<TypeAndShape> TypeAndShape::Characterize(
115     const semantics::AssocEntityDetails &assoc, FoldingContext &context) {
116   std::optional<TypeAndShape> result;
117   if (auto type{DynamicType::From(assoc.type())}) {
118     if (auto rank{assoc.rank()}) {
119       if (*rank >= 0 && *rank <= common::maxRank) {
120         result = TypeAndShape{std::move(*type), Shape(*rank)};
121       }
122     } else if (auto shape{GetShape(context, assoc.expr())}) {
123       result = TypeAndShape{std::move(*type), std::move(*shape)};
124     }
125     if (result && type->category() == TypeCategory::Character) {
126       if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(assoc.expr())}) {
127         if (auto len{chExpr->LEN()}) {
128           result->set_LEN(std::move(*len));
129         }
130       }
131     }
132   }
133   return Fold(context, std::move(result));
134 }
135 
136 std::optional<TypeAndShape> TypeAndShape::Characterize(
137     const semantics::DeclTypeSpec &spec, FoldingContext &context) {
138   if (auto type{DynamicType::From(spec)}) {
139     return Fold(context, TypeAndShape{std::move(*type)});
140   } else {
141     return std::nullopt;
142   }
143 }
144 
145 std::optional<TypeAndShape> TypeAndShape::Characterize(
146     const ActualArgument &arg, FoldingContext &context) {
147   return Characterize(arg.UnwrapExpr(), context);
148 }
149 
150 bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
151     const TypeAndShape &that, const char *thisIs, const char *thatIs,
152     bool omitShapeConformanceCheck,
153     enum CheckConformanceFlags::Flags flags) const {
154   if (!type_.IsTkCompatibleWith(that.type_)) {
155     messages.Say(
156         "%1$s type '%2$s' is not compatible with %3$s type '%4$s'"_err_en_US,
157         thatIs, that.AsFortran(), thisIs, AsFortran());
158     return false;
159   }
160   return omitShapeConformanceCheck ||
161       CheckConformance(messages, shape_, that.shape_, flags, thisIs, thatIs)
162           .value_or(true /*fail only when nonconformance is known now*/);
163 }
164 
165 std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureElementSizeInBytes(
166     FoldingContext &foldingContext, bool align) const {
167   if (LEN_) {
168     CHECK(type_.category() == TypeCategory::Character);
169     return Fold(foldingContext,
170         Expr<SubscriptInteger>{type_.kind()} * Expr<SubscriptInteger>{*LEN_});
171   }
172   if (auto elementBytes{type_.MeasureSizeInBytes(foldingContext, align)}) {
173     return Fold(foldingContext, std::move(*elementBytes));
174   }
175   return std::nullopt;
176 }
177 
178 std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
179     FoldingContext &foldingContext) const {
180   if (auto elements{GetSize(Shape{shape_})}) {
181     // Sizes of arrays (even with single elements) are multiples of
182     // their alignments.
183     if (auto elementBytes{
184             MeasureElementSizeInBytes(foldingContext, GetRank(shape_) > 0)}) {
185       return Fold(
186           foldingContext, std::move(*elements) * std::move(*elementBytes));
187     }
188   }
189   return std::nullopt;
190 }
191 
192 void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
193   if (IsAssumedShape(symbol)) {
194     attrs_.set(Attr::AssumedShape);
195   }
196   if (IsDeferredShape(symbol)) {
197     attrs_.set(Attr::DeferredShape);
198   }
199   if (const auto *object{
200           symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
201     corank_ = object->coshape().Rank();
202     if (object->IsAssumedRank()) {
203       attrs_.set(Attr::AssumedRank);
204     }
205     if (object->IsAssumedSize()) {
206       attrs_.set(Attr::AssumedSize);
207     }
208     if (object->IsCoarray()) {
209       attrs_.set(Attr::Coarray);
210     }
211   }
212 }
213 
214 void TypeAndShape::AcquireLEN() {
215   if (auto len{type_.GetCharLength()}) {
216     LEN_ = std::move(len);
217   }
218 }
219 
220 void TypeAndShape::AcquireLEN(const semantics::Symbol &symbol) {
221   if (type_.category() == TypeCategory::Character) {
222     if (auto len{DataRef{symbol}.LEN()}) {
223       LEN_ = std::move(*len);
224     }
225   }
226 }
227 
228 std::string TypeAndShape::AsFortran() const {
229   return type_.AsFortran(LEN_ ? LEN_->AsFortran() : "");
230 }
231 
232 llvm::raw_ostream &TypeAndShape::Dump(llvm::raw_ostream &o) const {
233   o << type_.AsFortran(LEN_ ? LEN_->AsFortran() : "");
234   attrs_.Dump(o, EnumToString);
235   if (!shape_.empty()) {
236     o << " dimension";
237     char sep{'('};
238     for (const auto &expr : shape_) {
239       o << sep;
240       sep = ',';
241       if (expr) {
242         expr->AsFortran(o);
243       } else {
244         o << ':';
245       }
246     }
247     o << ')';
248   }
249   return o;
250 }
251 
252 bool DummyDataObject::operator==(const DummyDataObject &that) const {
253   return type == that.type && attrs == that.attrs && intent == that.intent &&
254       coshape == that.coshape;
255 }
256 
257 bool DummyDataObject::IsCompatibleWith(const DummyDataObject &actual) const {
258   return type.shape() == actual.type.shape() &&
259       type.type().IsTkCompatibleWith(actual.type.type()) &&
260       attrs == actual.attrs && intent == actual.intent &&
261       coshape == actual.coshape;
262 }
263 
264 static common::Intent GetIntent(const semantics::Attrs &attrs) {
265   if (attrs.test(semantics::Attr::INTENT_IN)) {
266     return common::Intent::In;
267   } else if (attrs.test(semantics::Attr::INTENT_OUT)) {
268     return common::Intent::Out;
269   } else if (attrs.test(semantics::Attr::INTENT_INOUT)) {
270     return common::Intent::InOut;
271   } else {
272     return common::Intent::Default;
273   }
274 }
275 
276 std::optional<DummyDataObject> DummyDataObject::Characterize(
277     const semantics::Symbol &symbol, FoldingContext &context) {
278   if (symbol.has<semantics::ObjectEntityDetails>() ||
279       symbol.has<semantics::EntityDetails>()) {
280     if (auto type{TypeAndShape::Characterize(symbol, context)}) {
281       std::optional<DummyDataObject> result{std::move(*type)};
282       using semantics::Attr;
283       CopyAttrs<DummyDataObject, DummyDataObject::Attr>(symbol, *result,
284           {
285               {Attr::OPTIONAL, DummyDataObject::Attr::Optional},
286               {Attr::ALLOCATABLE, DummyDataObject::Attr::Allocatable},
287               {Attr::ASYNCHRONOUS, DummyDataObject::Attr::Asynchronous},
288               {Attr::CONTIGUOUS, DummyDataObject::Attr::Contiguous},
289               {Attr::VALUE, DummyDataObject::Attr::Value},
290               {Attr::VOLATILE, DummyDataObject::Attr::Volatile},
291               {Attr::POINTER, DummyDataObject::Attr::Pointer},
292               {Attr::TARGET, DummyDataObject::Attr::Target},
293           });
294       result->intent = GetIntent(symbol.attrs());
295       return result;
296     }
297   }
298   return std::nullopt;
299 }
300 
301 bool DummyDataObject::CanBePassedViaImplicitInterface() const {
302   if ((attrs &
303           Attrs{Attr::Allocatable, Attr::Asynchronous, Attr::Optional,
304               Attr::Pointer, Attr::Target, Attr::Value, Attr::Volatile})
305           .any()) {
306     return false; // 15.4.2.2(3)(a)
307   } else if ((type.attrs() &
308                  TypeAndShape::Attrs{TypeAndShape::Attr::AssumedShape,
309                      TypeAndShape::Attr::AssumedRank,
310                      TypeAndShape::Attr::Coarray})
311                  .any()) {
312     return false; // 15.4.2.2(3)(b-d)
313   } else if (type.type().IsPolymorphic()) {
314     return false; // 15.4.2.2(3)(f)
315   } else if (const auto *derived{GetDerivedTypeSpec(type.type())}) {
316     return derived->parameters().empty(); // 15.4.2.2(3)(e)
317   } else {
318     return true;
319   }
320 }
321 
322 llvm::raw_ostream &DummyDataObject::Dump(llvm::raw_ostream &o) const {
323   attrs.Dump(o, EnumToString);
324   if (intent != common::Intent::Default) {
325     o << "INTENT(" << common::EnumToString(intent) << ')';
326   }
327   type.Dump(o);
328   if (!coshape.empty()) {
329     char sep{'['};
330     for (const auto &expr : coshape) {
331       expr.AsFortran(o << sep);
332       sep = ',';
333     }
334   }
335   return o;
336 }
337 
338 DummyProcedure::DummyProcedure(Procedure &&p)
339     : procedure{new Procedure{std::move(p)}} {}
340 
341 bool DummyProcedure::operator==(const DummyProcedure &that) const {
342   return attrs == that.attrs && intent == that.intent &&
343       procedure.value() == that.procedure.value();
344 }
345 
346 bool DummyProcedure::IsCompatibleWith(const DummyProcedure &actual) const {
347   return attrs == actual.attrs && intent == actual.intent &&
348       procedure.value().IsCompatibleWith(actual.procedure.value());
349 }
350 
351 static std::string GetSeenProcs(
352     const semantics::UnorderedSymbolSet &seenProcs) {
353   // Sort the symbols so that they appear in the same order on all platforms
354   auto ordered{semantics::OrderBySourcePosition(seenProcs)};
355   std::string result;
356   llvm::interleave(
357       ordered,
358       [&](const SymbolRef p) { result += '\'' + p->name().ToString() + '\''; },
359       [&]() { result += ", "; });
360   return result;
361 }
362 
363 // These functions with arguments of type UnorderedSymbolSet are used with
364 // mutually recursive calls when characterizing a Procedure, a DummyArgument,
365 // or a DummyProcedure to detect circularly defined procedures as required by
366 // 15.4.3.6, paragraph 2.
367 static std::optional<DummyArgument> CharacterizeDummyArgument(
368     const semantics::Symbol &symbol, FoldingContext &context,
369     semantics::UnorderedSymbolSet seenProcs);
370 static std::optional<FunctionResult> CharacterizeFunctionResult(
371     const semantics::Symbol &symbol, FoldingContext &context,
372     semantics::UnorderedSymbolSet seenProcs);
373 
374 static std::optional<Procedure> CharacterizeProcedure(
375     const semantics::Symbol &original, FoldingContext &context,
376     semantics::UnorderedSymbolSet seenProcs) {
377   Procedure result;
378   const auto &symbol{ResolveAssociations(original)};
379   if (seenProcs.find(symbol) != seenProcs.end()) {
380     std::string procsList{GetSeenProcs(seenProcs)};
381     context.messages().Say(symbol.name(),
382         "Procedure '%s' is recursively defined.  Procedures in the cycle:"
383         " %s"_err_en_US,
384         symbol.name(), procsList);
385     return std::nullopt;
386   }
387   seenProcs.insert(symbol);
388   CopyAttrs<Procedure, Procedure::Attr>(symbol, result,
389       {
390           {semantics::Attr::ELEMENTAL, Procedure::Attr::Elemental},
391           {semantics::Attr::BIND_C, Procedure::Attr::BindC},
392       });
393   if (IsPureProcedure(symbol) || // works for ENTRY too
394       (!symbol.attrs().test(semantics::Attr::IMPURE) &&
395           result.attrs.test(Procedure::Attr::Elemental))) {
396     result.attrs.set(Procedure::Attr::Pure);
397   }
398   return common::visit(
399       common::visitors{
400           [&](const semantics::SubprogramDetails &subp)
401               -> std::optional<Procedure> {
402             if (subp.isFunction()) {
403               if (auto fr{CharacterizeFunctionResult(
404                       subp.result(), context, seenProcs)}) {
405                 result.functionResult = std::move(fr);
406               } else {
407                 return std::nullopt;
408               }
409             } else {
410               result.attrs.set(Procedure::Attr::Subroutine);
411             }
412             for (const semantics::Symbol *arg : subp.dummyArgs()) {
413               if (!arg) {
414                 if (subp.isFunction()) {
415                   return std::nullopt;
416                 } else {
417                   result.dummyArguments.emplace_back(AlternateReturn{});
418                 }
419               } else if (auto argCharacteristics{CharacterizeDummyArgument(
420                              *arg, context, seenProcs)}) {
421                 result.dummyArguments.emplace_back(
422                     std::move(argCharacteristics.value()));
423               } else {
424                 return std::nullopt;
425               }
426             }
427             return result;
428           },
429           [&](const semantics::ProcEntityDetails &proc)
430               -> std::optional<Procedure> {
431             if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
432               // Fails when the intrinsic is not a specific intrinsic function
433               // from F'2018 table 16.2.  In order to handle forward references,
434               // attempts to use impermissible intrinsic procedures as the
435               // interfaces of procedure pointers are caught and flagged in
436               // declaration checking in Semantics.
437               auto intrinsic{context.intrinsics().IsSpecificIntrinsicFunction(
438                   symbol.name().ToString())};
439               if (intrinsic && intrinsic->isRestrictedSpecific) {
440                 intrinsic.reset(); // Exclude intrinsics from table 16.3.
441               }
442               return intrinsic;
443             }
444             const semantics::ProcInterface &interface { proc.interface() };
445             if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
446               return CharacterizeProcedure(
447                   *interfaceSymbol, context, seenProcs);
448             } else {
449               result.attrs.set(Procedure::Attr::ImplicitInterface);
450               const semantics::DeclTypeSpec *type{interface.type()};
451               if (symbol.test(semantics::Symbol::Flag::Subroutine)) {
452                 // ignore any implicit typing
453                 result.attrs.set(Procedure::Attr::Subroutine);
454               } else if (type) {
455                 if (auto resultType{DynamicType::From(*type)}) {
456                   result.functionResult = FunctionResult{*resultType};
457                 } else {
458                   return std::nullopt;
459                 }
460               } else if (symbol.test(semantics::Symbol::Flag::Function)) {
461                 return std::nullopt;
462               }
463               // The PASS name, if any, is not a characteristic.
464               return result;
465             }
466           },
467           [&](const semantics::ProcBindingDetails &binding) {
468             if (auto result{CharacterizeProcedure(
469                     binding.symbol(), context, seenProcs)}) {
470               if (!symbol.attrs().test(semantics::Attr::NOPASS)) {
471                 auto passName{binding.passName()};
472                 for (auto &dummy : result->dummyArguments) {
473                   if (!passName || dummy.name.c_str() == *passName) {
474                     dummy.pass = true;
475                     return result;
476                   }
477                 }
478                 DIE("PASS argument missing");
479               }
480               return result;
481             } else {
482               return std::optional<Procedure>{};
483             }
484           },
485           [&](const semantics::UseDetails &use) {
486             return CharacterizeProcedure(use.symbol(), context, seenProcs);
487           },
488           [](const semantics::UseErrorDetails &) {
489             // Ambiguous use-association will be handled later during symbol
490             // checks, ignore UseErrorDetails here without actual symbol usage.
491             return std::optional<Procedure>{};
492           },
493           [&](const semantics::HostAssocDetails &assoc) {
494             return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
495           },
496           [&](const semantics::EntityDetails &) {
497             context.messages().Say(
498                 "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
499                 symbol.name());
500             return std::optional<Procedure>{};
501           },
502           [&](const semantics::SubprogramNameDetails &) {
503             context.messages().Say(
504                 "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
505                 symbol.name());
506             return std::optional<Procedure>{};
507           },
508           [&](const auto &) {
509             context.messages().Say(
510                 "'%s' is not a procedure"_err_en_US, symbol.name());
511             return std::optional<Procedure>{};
512           },
513       },
514       symbol.details());
515 }
516 
517 static std::optional<DummyProcedure> CharacterizeDummyProcedure(
518     const semantics::Symbol &symbol, FoldingContext &context,
519     semantics::UnorderedSymbolSet seenProcs) {
520   if (auto procedure{CharacterizeProcedure(symbol, context, seenProcs)}) {
521     // Dummy procedures may not be elemental.  Elemental dummy procedure
522     // interfaces are errors when the interface is not intrinsic, and that
523     // error is caught elsewhere.  Elemental intrinsic interfaces are
524     // made non-elemental.
525     procedure->attrs.reset(Procedure::Attr::Elemental);
526     DummyProcedure result{std::move(procedure.value())};
527     CopyAttrs<DummyProcedure, DummyProcedure::Attr>(symbol, result,
528         {
529             {semantics::Attr::OPTIONAL, DummyProcedure::Attr::Optional},
530             {semantics::Attr::POINTER, DummyProcedure::Attr::Pointer},
531         });
532     result.intent = GetIntent(symbol.attrs());
533     return result;
534   } else {
535     return std::nullopt;
536   }
537 }
538 
539 llvm::raw_ostream &DummyProcedure::Dump(llvm::raw_ostream &o) const {
540   attrs.Dump(o, EnumToString);
541   if (intent != common::Intent::Default) {
542     o << "INTENT(" << common::EnumToString(intent) << ')';
543   }
544   procedure.value().Dump(o);
545   return o;
546 }
547 
548 llvm::raw_ostream &AlternateReturn::Dump(llvm::raw_ostream &o) const {
549   return o << '*';
550 }
551 
552 DummyArgument::~DummyArgument() {}
553 
554 bool DummyArgument::operator==(const DummyArgument &that) const {
555   return u == that.u; // name and passed-object usage are not characteristics
556 }
557 
558 bool DummyArgument::IsCompatibleWith(const DummyArgument &actual) const {
559   if (const auto *ifaceData{std::get_if<DummyDataObject>(&u)}) {
560     const auto *actualData{std::get_if<DummyDataObject>(&actual.u)};
561     return actualData && ifaceData->IsCompatibleWith(*actualData);
562   } else if (const auto *ifaceProc{std::get_if<DummyProcedure>(&u)}) {
563     const auto *actualProc{std::get_if<DummyProcedure>(&actual.u)};
564     return actualProc && ifaceProc->IsCompatibleWith(*actualProc);
565   } else {
566     return std::holds_alternative<AlternateReturn>(u) &&
567         std::holds_alternative<AlternateReturn>(actual.u);
568   }
569 }
570 
571 static std::optional<DummyArgument> CharacterizeDummyArgument(
572     const semantics::Symbol &symbol, FoldingContext &context,
573     semantics::UnorderedSymbolSet seenProcs) {
574   auto name{symbol.name().ToString()};
575   if (symbol.has<semantics::ObjectEntityDetails>() ||
576       symbol.has<semantics::EntityDetails>()) {
577     if (auto obj{DummyDataObject::Characterize(symbol, context)}) {
578       return DummyArgument{std::move(name), std::move(obj.value())};
579     }
580   } else if (auto proc{
581                  CharacterizeDummyProcedure(symbol, context, seenProcs)}) {
582     return DummyArgument{std::move(name), std::move(proc.value())};
583   }
584   return std::nullopt;
585 }
586 
587 std::optional<DummyArgument> DummyArgument::FromActual(
588     std::string &&name, const Expr<SomeType> &expr, FoldingContext &context) {
589   return common::visit(
590       common::visitors{
591           [&](const BOZLiteralConstant &) {
592             return std::make_optional<DummyArgument>(std::move(name),
593                 DummyDataObject{
594                     TypeAndShape{DynamicType::TypelessIntrinsicArgument()}});
595           },
596           [&](const NullPointer &) {
597             return std::make_optional<DummyArgument>(std::move(name),
598                 DummyDataObject{
599                     TypeAndShape{DynamicType::TypelessIntrinsicArgument()}});
600           },
601           [&](const ProcedureDesignator &designator) {
602             if (auto proc{Procedure::Characterize(designator, context)}) {
603               return std::make_optional<DummyArgument>(
604                   std::move(name), DummyProcedure{std::move(*proc)});
605             } else {
606               return std::optional<DummyArgument>{};
607             }
608           },
609           [&](const ProcedureRef &call) {
610             if (auto proc{Procedure::Characterize(call, context)}) {
611               return std::make_optional<DummyArgument>(
612                   std::move(name), DummyProcedure{std::move(*proc)});
613             } else {
614               return std::optional<DummyArgument>{};
615             }
616           },
617           [&](const auto &) {
618             if (auto type{TypeAndShape::Characterize(expr, context)}) {
619               return std::make_optional<DummyArgument>(
620                   std::move(name), DummyDataObject{std::move(*type)});
621             } else {
622               return std::optional<DummyArgument>{};
623             }
624           },
625       },
626       expr.u);
627 }
628 
629 bool DummyArgument::IsOptional() const {
630   return common::visit(
631       common::visitors{
632           [](const DummyDataObject &data) {
633             return data.attrs.test(DummyDataObject::Attr::Optional);
634           },
635           [](const DummyProcedure &proc) {
636             return proc.attrs.test(DummyProcedure::Attr::Optional);
637           },
638           [](const AlternateReturn &) { return false; },
639       },
640       u);
641 }
642 
643 void DummyArgument::SetOptional(bool value) {
644   common::visit(common::visitors{
645                     [value](DummyDataObject &data) {
646                       data.attrs.set(DummyDataObject::Attr::Optional, value);
647                     },
648                     [value](DummyProcedure &proc) {
649                       proc.attrs.set(DummyProcedure::Attr::Optional, value);
650                     },
651                     [](AlternateReturn &) { DIE("cannot set optional"); },
652                 },
653       u);
654 }
655 
656 void DummyArgument::SetIntent(common::Intent intent) {
657   common::visit(common::visitors{
658                     [intent](DummyDataObject &data) { data.intent = intent; },
659                     [intent](DummyProcedure &proc) { proc.intent = intent; },
660                     [](AlternateReturn &) { DIE("cannot set intent"); },
661                 },
662       u);
663 }
664 
665 common::Intent DummyArgument::GetIntent() const {
666   return common::visit(
667       common::visitors{
668           [](const DummyDataObject &data) { return data.intent; },
669           [](const DummyProcedure &proc) { return proc.intent; },
670           [](const AlternateReturn &) -> common::Intent {
671             DIE("Alternate returns have no intent");
672           },
673       },
674       u);
675 }
676 
677 bool DummyArgument::CanBePassedViaImplicitInterface() const {
678   if (const auto *object{std::get_if<DummyDataObject>(&u)}) {
679     return object->CanBePassedViaImplicitInterface();
680   } else {
681     return true;
682   }
683 }
684 
685 bool DummyArgument::IsTypelessIntrinsicDummy() const {
686   const auto *argObj{std::get_if<characteristics::DummyDataObject>(&u)};
687   return argObj && argObj->type.type().IsTypelessIntrinsicArgument();
688 }
689 
690 llvm::raw_ostream &DummyArgument::Dump(llvm::raw_ostream &o) const {
691   if (!name.empty()) {
692     o << name << '=';
693   }
694   if (pass) {
695     o << " PASS";
696   }
697   common::visit([&](const auto &x) { x.Dump(o); }, u);
698   return o;
699 }
700 
701 FunctionResult::FunctionResult(DynamicType t) : u{TypeAndShape{t}} {}
702 FunctionResult::FunctionResult(TypeAndShape &&t) : u{std::move(t)} {}
703 FunctionResult::FunctionResult(Procedure &&p) : u{std::move(p)} {}
704 FunctionResult::~FunctionResult() {}
705 
706 bool FunctionResult::operator==(const FunctionResult &that) const {
707   return attrs == that.attrs && u == that.u;
708 }
709 
710 static std::optional<FunctionResult> CharacterizeFunctionResult(
711     const semantics::Symbol &symbol, FoldingContext &context,
712     semantics::UnorderedSymbolSet seenProcs) {
713   if (symbol.has<semantics::ObjectEntityDetails>()) {
714     if (auto type{TypeAndShape::Characterize(symbol, context)}) {
715       FunctionResult result{std::move(*type)};
716       CopyAttrs<FunctionResult, FunctionResult::Attr>(symbol, result,
717           {
718               {semantics::Attr::ALLOCATABLE, FunctionResult::Attr::Allocatable},
719               {semantics::Attr::CONTIGUOUS, FunctionResult::Attr::Contiguous},
720               {semantics::Attr::POINTER, FunctionResult::Attr::Pointer},
721           });
722       return result;
723     }
724   } else if (auto maybeProc{
725                  CharacterizeProcedure(symbol, context, seenProcs)}) {
726     FunctionResult result{std::move(*maybeProc)};
727     result.attrs.set(FunctionResult::Attr::Pointer);
728     return result;
729   }
730   return std::nullopt;
731 }
732 
733 std::optional<FunctionResult> FunctionResult::Characterize(
734     const Symbol &symbol, FoldingContext &context) {
735   semantics::UnorderedSymbolSet seenProcs;
736   return CharacterizeFunctionResult(symbol, context, seenProcs);
737 }
738 
739 bool FunctionResult::IsAssumedLengthCharacter() const {
740   if (const auto *ts{std::get_if<TypeAndShape>(&u)}) {
741     return ts->type().IsAssumedLengthCharacter();
742   } else {
743     return false;
744   }
745 }
746 
747 bool FunctionResult::CanBeReturnedViaImplicitInterface() const {
748   if (attrs.test(Attr::Pointer) || attrs.test(Attr::Allocatable)) {
749     return false; // 15.4.2.2(4)(b)
750   } else if (const auto *typeAndShape{GetTypeAndShape()}) {
751     if (typeAndShape->Rank() > 0) {
752       return false; // 15.4.2.2(4)(a)
753     } else {
754       const DynamicType &type{typeAndShape->type()};
755       switch (type.category()) {
756       case TypeCategory::Character:
757         if (type.knownLength()) {
758           return true;
759         } else if (const auto *param{type.charLengthParamValue()}) {
760           if (const auto &expr{param->GetExplicit()}) {
761             return IsConstantExpr(*expr); // 15.4.2.2(4)(c)
762           } else if (param->isAssumed()) {
763             return true;
764           }
765         }
766         return false;
767       case TypeCategory::Derived:
768         if (!type.IsPolymorphic()) {
769           const auto &spec{type.GetDerivedTypeSpec()};
770           for (const auto &pair : spec.parameters()) {
771             if (const auto &expr{pair.second.GetExplicit()}) {
772               if (!IsConstantExpr(*expr)) {
773                 return false; // 15.4.2.2(4)(c)
774               }
775             }
776           }
777           return true;
778         }
779         return false;
780       default:
781         return true;
782       }
783     }
784   } else {
785     return false; // 15.4.2.2(4)(b) - procedure pointer
786   }
787 }
788 
789 bool FunctionResult::IsCompatibleWith(const FunctionResult &actual) const {
790   Attrs actualAttrs{actual.attrs};
791   actualAttrs.reset(Attr::Contiguous);
792   if (attrs != actualAttrs) {
793     return false;
794   } else if (const auto *ifaceTypeShape{std::get_if<TypeAndShape>(&u)}) {
795     if (const auto *actualTypeShape{std::get_if<TypeAndShape>(&actual.u)}) {
796       if (ifaceTypeShape->Rank() != actualTypeShape->Rank()) {
797         return false;
798       } else if (!attrs.test(Attr::Allocatable) && !attrs.test(Attr::Pointer) &&
799           ifaceTypeShape->shape() != actualTypeShape->shape()) {
800         return false;
801       } else {
802         return ifaceTypeShape->type().IsTkCompatibleWith(
803             actualTypeShape->type());
804       }
805     } else {
806       return false;
807     }
808   } else {
809     const auto *ifaceProc{std::get_if<CopyableIndirection<Procedure>>(&u)};
810     if (const auto *actualProc{
811             std::get_if<CopyableIndirection<Procedure>>(&actual.u)}) {
812       return ifaceProc->value().IsCompatibleWith(actualProc->value());
813     } else {
814       return false;
815     }
816   }
817 }
818 
819 llvm::raw_ostream &FunctionResult::Dump(llvm::raw_ostream &o) const {
820   attrs.Dump(o, EnumToString);
821   common::visit(common::visitors{
822                     [&](const TypeAndShape &ts) { ts.Dump(o); },
823                     [&](const CopyableIndirection<Procedure> &p) {
824                       p.value().Dump(o << " procedure(") << ')';
825                     },
826                 },
827       u);
828   return o;
829 }
830 
831 Procedure::Procedure(FunctionResult &&fr, DummyArguments &&args, Attrs a)
832     : functionResult{std::move(fr)}, dummyArguments{std::move(args)}, attrs{a} {
833 }
834 Procedure::Procedure(DummyArguments &&args, Attrs a)
835     : dummyArguments{std::move(args)}, attrs{a} {}
836 Procedure::~Procedure() {}
837 
838 bool Procedure::operator==(const Procedure &that) const {
839   return attrs == that.attrs && functionResult == that.functionResult &&
840       dummyArguments == that.dummyArguments;
841 }
842 
843 bool Procedure::IsCompatibleWith(const Procedure &actual) const {
844   // 15.5.2.9(1): if dummy is not pure, actual need not be.
845   Attrs actualAttrs{actual.attrs};
846   if (!attrs.test(Attr::Pure)) {
847     actualAttrs.reset(Attr::Pure);
848   }
849   if (attrs != actualAttrs) {
850     return false;
851   } else if (IsFunction() != actual.IsFunction()) {
852     return false;
853   } else if (IsFunction() &&
854       !functionResult->IsCompatibleWith(*actual.functionResult)) {
855     return false;
856   } else if (dummyArguments.size() != actual.dummyArguments.size()) {
857     return false;
858   } else {
859     for (std::size_t j{0}; j < dummyArguments.size(); ++j) {
860       if (!dummyArguments[j].IsCompatibleWith(actual.dummyArguments[j])) {
861         return false;
862       }
863     }
864     return true;
865   }
866 }
867 
868 int Procedure::FindPassIndex(std::optional<parser::CharBlock> name) const {
869   int argCount{static_cast<int>(dummyArguments.size())};
870   int index{0};
871   if (name) {
872     while (index < argCount && *name != dummyArguments[index].name.c_str()) {
873       ++index;
874     }
875   }
876   CHECK(index < argCount);
877   return index;
878 }
879 
880 bool Procedure::CanOverride(
881     const Procedure &that, std::optional<int> passIndex) const {
882   // A pure procedure may override an impure one (7.5.7.3(2))
883   if ((that.attrs.test(Attr::Pure) && !attrs.test(Attr::Pure)) ||
884       that.attrs.test(Attr::Elemental) != attrs.test(Attr::Elemental) ||
885       functionResult != that.functionResult) {
886     return false;
887   }
888   int argCount{static_cast<int>(dummyArguments.size())};
889   if (argCount != static_cast<int>(that.dummyArguments.size())) {
890     return false;
891   }
892   for (int j{0}; j < argCount; ++j) {
893     if ((!passIndex || j != *passIndex) &&
894         dummyArguments[j] != that.dummyArguments[j]) {
895       return false;
896     }
897   }
898   return true;
899 }
900 
901 std::optional<Procedure> Procedure::Characterize(
902     const semantics::Symbol &original, FoldingContext &context) {
903   semantics::UnorderedSymbolSet seenProcs;
904   return CharacterizeProcedure(original, context, seenProcs);
905 }
906 
907 std::optional<Procedure> Procedure::Characterize(
908     const ProcedureDesignator &proc, FoldingContext &context) {
909   if (const auto *symbol{proc.GetSymbol()}) {
910     if (auto result{
911             characteristics::Procedure::Characterize(*symbol, context)}) {
912       return result;
913     }
914   } else if (const auto *intrinsic{proc.GetSpecificIntrinsic()}) {
915     return intrinsic->characteristics.value();
916   }
917   return std::nullopt;
918 }
919 
920 std::optional<Procedure> Procedure::Characterize(
921     const ProcedureRef &ref, FoldingContext &context) {
922   if (auto callee{Characterize(ref.proc(), context)}) {
923     if (callee->functionResult) {
924       if (const Procedure *
925           proc{callee->functionResult->IsProcedurePointer()}) {
926         return {*proc};
927       }
928     }
929   }
930   return std::nullopt;
931 }
932 
933 bool Procedure::CanBeCalledViaImplicitInterface() const {
934   // TODO: Pass back information on why we return false
935   if (attrs.test(Attr::Elemental) || attrs.test(Attr::BindC)) {
936     return false; // 15.4.2.2(5,6)
937   } else if (IsFunction() &&
938       !functionResult->CanBeReturnedViaImplicitInterface()) {
939     return false;
940   } else {
941     for (const DummyArgument &arg : dummyArguments) {
942       if (!arg.CanBePassedViaImplicitInterface()) {
943         return false;
944       }
945     }
946     return true;
947   }
948 }
949 
950 llvm::raw_ostream &Procedure::Dump(llvm::raw_ostream &o) const {
951   attrs.Dump(o, EnumToString);
952   if (functionResult) {
953     functionResult->Dump(o << "TYPE(") << ") FUNCTION";
954   } else {
955     o << "SUBROUTINE";
956   }
957   char sep{'('};
958   for (const auto &dummy : dummyArguments) {
959     dummy.Dump(o << sep);
960     sep = ',';
961   }
962   return o << (sep == '(' ? "()" : ")");
963 }
964 
965 // Utility class to determine if Procedures, etc. are distinguishable
966 class DistinguishUtils {
967 public:
968   explicit DistinguishUtils(const common::LanguageFeatureControl &features)
969       : features_{features} {}
970 
971   // Are these procedures distinguishable for a generic name?
972   bool Distinguishable(const Procedure &, const Procedure &) const;
973   // Are these procedures distinguishable for a generic operator or assignment?
974   bool DistinguishableOpOrAssign(const Procedure &, const Procedure &) const;
975 
976 private:
977   struct CountDummyProcedures {
978     CountDummyProcedures(const DummyArguments &args) {
979       for (const DummyArgument &arg : args) {
980         if (std::holds_alternative<DummyProcedure>(arg.u)) {
981           total += 1;
982           notOptional += !arg.IsOptional();
983         }
984       }
985     }
986     int total{0};
987     int notOptional{0};
988   };
989 
990   bool Rule3Distinguishable(const Procedure &, const Procedure &) const;
991   const DummyArgument *Rule1DistinguishingArg(
992       const DummyArguments &, const DummyArguments &) const;
993   int FindFirstToDistinguishByPosition(
994       const DummyArguments &, const DummyArguments &) const;
995   int FindLastToDistinguishByName(
996       const DummyArguments &, const DummyArguments &) const;
997   int CountCompatibleWith(const DummyArgument &, const DummyArguments &) const;
998   int CountNotDistinguishableFrom(
999       const DummyArgument &, const DummyArguments &) const;
1000   bool Distinguishable(const DummyArgument &, const DummyArgument &) const;
1001   bool Distinguishable(const DummyDataObject &, const DummyDataObject &) const;
1002   bool Distinguishable(const DummyProcedure &, const DummyProcedure &) const;
1003   bool Distinguishable(const FunctionResult &, const FunctionResult &) const;
1004   bool Distinguishable(const TypeAndShape &, const TypeAndShape &) const;
1005   bool IsTkrCompatible(const DummyArgument &, const DummyArgument &) const;
1006   bool IsTkrCompatible(const TypeAndShape &, const TypeAndShape &) const;
1007   const DummyArgument *GetAtEffectivePosition(
1008       const DummyArguments &, int) const;
1009   const DummyArgument *GetPassArg(const Procedure &) const;
1010 
1011   const common::LanguageFeatureControl &features_;
1012 };
1013 
1014 // Simpler distinguishability rules for operators and assignment
1015 bool DistinguishUtils::DistinguishableOpOrAssign(
1016     const Procedure &proc1, const Procedure &proc2) const {
1017   auto &args1{proc1.dummyArguments};
1018   auto &args2{proc2.dummyArguments};
1019   if (args1.size() != args2.size()) {
1020     return true; // C1511: distinguishable based on number of arguments
1021   }
1022   for (std::size_t i{0}; i < args1.size(); ++i) {
1023     if (Distinguishable(args1[i], args2[i])) {
1024       return true; // C1511, C1512: distinguishable based on this arg
1025     }
1026   }
1027   return false;
1028 }
1029 
1030 bool DistinguishUtils::Distinguishable(
1031     const Procedure &proc1, const Procedure &proc2) const {
1032   auto &args1{proc1.dummyArguments};
1033   auto &args2{proc2.dummyArguments};
1034   auto count1{CountDummyProcedures(args1)};
1035   auto count2{CountDummyProcedures(args2)};
1036   if (count1.notOptional > count2.total || count2.notOptional > count1.total) {
1037     return true; // distinguishable based on C1514 rule 2
1038   }
1039   if (Rule3Distinguishable(proc1, proc2)) {
1040     return true; // distinguishable based on C1514 rule 3
1041   }
1042   if (Rule1DistinguishingArg(args1, args2)) {
1043     return true; // distinguishable based on C1514 rule 1
1044   }
1045   int pos1{FindFirstToDistinguishByPosition(args1, args2)};
1046   int name1{FindLastToDistinguishByName(args1, args2)};
1047   if (pos1 >= 0 && pos1 <= name1) {
1048     return true; // distinguishable based on C1514 rule 4
1049   }
1050   int pos2{FindFirstToDistinguishByPosition(args2, args1)};
1051   int name2{FindLastToDistinguishByName(args2, args1)};
1052   if (pos2 >= 0 && pos2 <= name2) {
1053     return true; // distinguishable based on C1514 rule 4
1054   }
1055   return false;
1056 }
1057 
1058 // C1514 rule 3: Procedures are distinguishable if both have a passed-object
1059 // dummy argument and those are distinguishable.
1060 bool DistinguishUtils::Rule3Distinguishable(
1061     const Procedure &proc1, const Procedure &proc2) const {
1062   const DummyArgument *pass1{GetPassArg(proc1)};
1063   const DummyArgument *pass2{GetPassArg(proc2)};
1064   return pass1 && pass2 && Distinguishable(*pass1, *pass2);
1065 }
1066 
1067 // Find a non-passed-object dummy data object in one of the argument lists
1068 // that satisfies C1514 rule 1. I.e. x such that:
1069 // - m is the number of dummy data objects in one that are nonoptional,
1070 //   are not passed-object, that x is TKR compatible with
1071 // - n is the number of non-passed-object dummy data objects, in the other
1072 //   that are not distinguishable from x
1073 // - m is greater than n
1074 const DummyArgument *DistinguishUtils::Rule1DistinguishingArg(
1075     const DummyArguments &args1, const DummyArguments &args2) const {
1076   auto size1{args1.size()};
1077   auto size2{args2.size()};
1078   for (std::size_t i{0}; i < size1 + size2; ++i) {
1079     const DummyArgument &x{i < size1 ? args1[i] : args2[i - size1]};
1080     if (!x.pass && std::holds_alternative<DummyDataObject>(x.u)) {
1081       if (CountCompatibleWith(x, args1) >
1082               CountNotDistinguishableFrom(x, args2) ||
1083           CountCompatibleWith(x, args2) >
1084               CountNotDistinguishableFrom(x, args1)) {
1085         return &x;
1086       }
1087     }
1088   }
1089   return nullptr;
1090 }
1091 
1092 // Find the index of the first nonoptional non-passed-object dummy argument
1093 // in args1 at an effective position such that either:
1094 // - args2 has no dummy argument at that effective position
1095 // - the dummy argument at that position is distinguishable from it
1096 int DistinguishUtils::FindFirstToDistinguishByPosition(
1097     const DummyArguments &args1, const DummyArguments &args2) const {
1098   int effective{0}; // position of arg1 in list, ignoring passed arg
1099   for (std::size_t i{0}; i < args1.size(); ++i) {
1100     const DummyArgument &arg1{args1.at(i)};
1101     if (!arg1.pass && !arg1.IsOptional()) {
1102       const DummyArgument *arg2{GetAtEffectivePosition(args2, effective)};
1103       if (!arg2 || Distinguishable(arg1, *arg2)) {
1104         return i;
1105       }
1106     }
1107     effective += !arg1.pass;
1108   }
1109   return -1;
1110 }
1111 
1112 // Find the index of the last nonoptional non-passed-object dummy argument
1113 // in args1 whose name is such that either:
1114 // - args2 has no dummy argument with that name
1115 // - the dummy argument with that name is distinguishable from it
1116 int DistinguishUtils::FindLastToDistinguishByName(
1117     const DummyArguments &args1, const DummyArguments &args2) const {
1118   std::map<std::string, const DummyArgument *> nameToArg;
1119   for (const auto &arg2 : args2) {
1120     nameToArg.emplace(arg2.name, &arg2);
1121   }
1122   for (int i = args1.size() - 1; i >= 0; --i) {
1123     const DummyArgument &arg1{args1.at(i)};
1124     if (!arg1.pass && !arg1.IsOptional()) {
1125       auto it{nameToArg.find(arg1.name)};
1126       if (it == nameToArg.end() || Distinguishable(arg1, *it->second)) {
1127         return i;
1128       }
1129     }
1130   }
1131   return -1;
1132 }
1133 
1134 // Count the dummy data objects in args that are nonoptional, are not
1135 // passed-object, and that x is TKR compatible with
1136 int DistinguishUtils::CountCompatibleWith(
1137     const DummyArgument &x, const DummyArguments &args) const {
1138   return std::count_if(args.begin(), args.end(), [&](const DummyArgument &y) {
1139     return !y.pass && !y.IsOptional() && IsTkrCompatible(x, y);
1140   });
1141 }
1142 
1143 // Return the number of dummy data objects in args that are not
1144 // distinguishable from x and not passed-object.
1145 int DistinguishUtils::CountNotDistinguishableFrom(
1146     const DummyArgument &x, const DummyArguments &args) const {
1147   return std::count_if(args.begin(), args.end(), [&](const DummyArgument &y) {
1148     return !y.pass && std::holds_alternative<DummyDataObject>(y.u) &&
1149         !Distinguishable(y, x);
1150   });
1151 }
1152 
1153 bool DistinguishUtils::Distinguishable(
1154     const DummyArgument &x, const DummyArgument &y) const {
1155   if (x.u.index() != y.u.index()) {
1156     return true; // different kind: data/proc/alt-return
1157   }
1158   return common::visit(
1159       common::visitors{
1160           [&](const DummyDataObject &z) {
1161             return Distinguishable(z, std::get<DummyDataObject>(y.u));
1162           },
1163           [&](const DummyProcedure &z) {
1164             return Distinguishable(z, std::get<DummyProcedure>(y.u));
1165           },
1166           [&](const AlternateReturn &) { return false; },
1167       },
1168       x.u);
1169 }
1170 
1171 bool DistinguishUtils::Distinguishable(
1172     const DummyDataObject &x, const DummyDataObject &y) const {
1173   using Attr = DummyDataObject::Attr;
1174   if (Distinguishable(x.type, y.type)) {
1175     return true;
1176   } else if (x.attrs.test(Attr::Allocatable) && y.attrs.test(Attr::Pointer) &&
1177       y.intent != common::Intent::In) {
1178     return true;
1179   } else if (y.attrs.test(Attr::Allocatable) && x.attrs.test(Attr::Pointer) &&
1180       x.intent != common::Intent::In) {
1181     return true;
1182   } else if (features_.IsEnabled(
1183                  common::LanguageFeature::DistinguishableSpecifics) &&
1184       (x.attrs.test(Attr::Allocatable) || x.attrs.test(Attr::Pointer)) &&
1185       (y.attrs.test(Attr::Allocatable) || y.attrs.test(Attr::Pointer)) &&
1186       (x.type.type().IsUnlimitedPolymorphic() !=
1187               y.type.type().IsUnlimitedPolymorphic() ||
1188           x.type.type().IsPolymorphic() != y.type.type().IsPolymorphic())) {
1189     // Extension: Per 15.5.2.5(2), an allocatable/pointer dummy and its
1190     // corresponding actual argument must both or neither be polymorphic,
1191     // and must both or neither be unlimited polymorphic.  So when exactly
1192     // one of two dummy arguments is polymorphic or unlimited polymorphic,
1193     // any actual argument that is admissible to one of them cannot also match
1194     // the other one.
1195     return true;
1196   } else {
1197     return false;
1198   }
1199 }
1200 
1201 bool DistinguishUtils::Distinguishable(
1202     const DummyProcedure &x, const DummyProcedure &y) const {
1203   const Procedure &xProc{x.procedure.value()};
1204   const Procedure &yProc{y.procedure.value()};
1205   if (Distinguishable(xProc, yProc)) {
1206     return true;
1207   } else {
1208     const std::optional<FunctionResult> &xResult{xProc.functionResult};
1209     const std::optional<FunctionResult> &yResult{yProc.functionResult};
1210     return xResult ? !yResult || Distinguishable(*xResult, *yResult)
1211                    : yResult.has_value();
1212   }
1213 }
1214 
1215 bool DistinguishUtils::Distinguishable(
1216     const FunctionResult &x, const FunctionResult &y) const {
1217   if (x.u.index() != y.u.index()) {
1218     return true; // one is data object, one is procedure
1219   }
1220   return common::visit(
1221       common::visitors{
1222           [&](const TypeAndShape &z) {
1223             return Distinguishable(z, std::get<TypeAndShape>(y.u));
1224           },
1225           [&](const CopyableIndirection<Procedure> &z) {
1226             return Distinguishable(z.value(),
1227                 std::get<CopyableIndirection<Procedure>>(y.u).value());
1228           },
1229       },
1230       x.u);
1231 }
1232 
1233 bool DistinguishUtils::Distinguishable(
1234     const TypeAndShape &x, const TypeAndShape &y) const {
1235   return !IsTkrCompatible(x, y) && !IsTkrCompatible(y, x);
1236 }
1237 
1238 // Compatibility based on type, kind, and rank
1239 bool DistinguishUtils::IsTkrCompatible(
1240     const DummyArgument &x, const DummyArgument &y) const {
1241   const auto *obj1{std::get_if<DummyDataObject>(&x.u)};
1242   const auto *obj2{std::get_if<DummyDataObject>(&y.u)};
1243   return obj1 && obj2 && IsTkrCompatible(obj1->type, obj2->type);
1244 }
1245 bool DistinguishUtils::IsTkrCompatible(
1246     const TypeAndShape &x, const TypeAndShape &y) const {
1247   return x.type().IsTkCompatibleWith(y.type()) &&
1248       (x.attrs().test(TypeAndShape::Attr::AssumedRank) ||
1249           y.attrs().test(TypeAndShape::Attr::AssumedRank) ||
1250           x.Rank() == y.Rank());
1251 }
1252 
1253 // Return the argument at the given index, ignoring the passed arg
1254 const DummyArgument *DistinguishUtils::GetAtEffectivePosition(
1255     const DummyArguments &args, int index) const {
1256   for (const DummyArgument &arg : args) {
1257     if (!arg.pass) {
1258       if (index == 0) {
1259         return &arg;
1260       }
1261       --index;
1262     }
1263   }
1264   return nullptr;
1265 }
1266 
1267 // Return the passed-object dummy argument of this procedure, if any
1268 const DummyArgument *DistinguishUtils::GetPassArg(const Procedure &proc) const {
1269   for (const auto &arg : proc.dummyArguments) {
1270     if (arg.pass) {
1271       return &arg;
1272     }
1273   }
1274   return nullptr;
1275 }
1276 
1277 bool Distinguishable(const common::LanguageFeatureControl &features,
1278     const Procedure &x, const Procedure &y) {
1279   return DistinguishUtils{features}.Distinguishable(x, y);
1280 }
1281 
1282 bool DistinguishableOpOrAssign(const common::LanguageFeatureControl &features,
1283     const Procedure &x, const Procedure &y) {
1284   return DistinguishUtils{features}.DistinguishableOpOrAssign(x, y);
1285 }
1286 
1287 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
1288 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
1289 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
1290 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
1291 } // namespace Fortran::evaluate::characteristics
1292 
1293 template class Fortran::common::Indirection<
1294     Fortran::evaluate::characteristics::Procedure, true>;
1295