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