1 //===-- lib/Semantics/type.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/Semantics/type.h"
10 #include "check-declarations.h"
11 #include "compute-offsets.h"
12 #include "flang/Evaluate/fold.h"
13 #include "flang/Evaluate/tools.h"
14 #include "flang/Parser/characters.h"
15 #include "flang/Semantics/scope.h"
16 #include "flang/Semantics/symbol.h"
17 #include "flang/Semantics/tools.h"
18 #include "llvm/Support/raw_ostream.h"
19 
20 namespace Fortran::semantics {
21 
22 DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol)
23     : name_{name}, typeSymbol_{typeSymbol} {
24   CHECK(typeSymbol.has<DerivedTypeDetails>());
25 }
26 DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default;
27 DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) = default;
28 
29 void DerivedTypeSpec::set_scope(const Scope &scope) {
30   CHECK(!scope_);
31   ReplaceScope(scope);
32 }
33 void DerivedTypeSpec::ReplaceScope(const Scope &scope) {
34   CHECK(scope.IsDerivedType());
35   scope_ = &scope;
36 }
37 
38 void DerivedTypeSpec::AddRawParamValue(
39     const std::optional<parser::Keyword> &keyword, ParamValue &&value) {
40   CHECK(parameters_.empty());
41   rawParameters_.emplace_back(keyword ? &*keyword : nullptr, std::move(value));
42 }
43 
44 void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) {
45   if (cooked_) {
46     return;
47   }
48   cooked_ = true;
49   auto &messages{foldingContext.messages()};
50   if (IsForwardReferenced()) {
51     messages.Say(typeSymbol_.name(),
52         "Derived type '%s' was used but never defined"_err_en_US,
53         typeSymbol_.name());
54     return;
55   }
56 
57   // Parameters of the most deeply nested "base class" come first when the
58   // derived type is an extension.
59   auto parameterNames{OrderParameterNames(typeSymbol_)};
60   auto parameterDecls{OrderParameterDeclarations(typeSymbol_)};
61   auto nextNameIter{parameterNames.begin()};
62   RawParameters raw{std::move(rawParameters_)};
63   for (auto &[maybeKeyword, value] : raw) {
64     SourceName name;
65     common::TypeParamAttr attr{common::TypeParamAttr::Kind};
66     if (maybeKeyword) {
67       name = maybeKeyword->v.source;
68       auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
69           [&](const Symbol &symbol) { return symbol.name() == name; })};
70       if (it == parameterDecls.end()) {
71         messages.Say(name,
72             "'%s' is not the name of a parameter for derived type '%s'"_err_en_US,
73             name, typeSymbol_.name());
74       } else {
75         // Resolve the keyword's symbol
76         maybeKeyword->v.symbol = const_cast<Symbol *>(&it->get());
77         attr = it->get().get<TypeParamDetails>().attr();
78       }
79     } else if (nextNameIter != parameterNames.end()) {
80       name = *nextNameIter++;
81       auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
82           [&](const Symbol &symbol) { return symbol.name() == name; })};
83       if (it == parameterDecls.end()) {
84         break;
85       }
86       attr = it->get().get<TypeParamDetails>().attr();
87     } else {
88       messages.Say(name_,
89           "Too many type parameters given for derived type '%s'"_err_en_US,
90           typeSymbol_.name());
91       break;
92     }
93     if (FindParameter(name)) {
94       messages.Say(name_,
95           "Multiple values given for type parameter '%s'"_err_en_US, name);
96     } else {
97       value.set_attr(attr);
98       AddParamValue(name, std::move(value));
99     }
100   }
101 }
102 
103 void DerivedTypeSpec::EvaluateParameters(SemanticsContext &context) {
104   evaluate::FoldingContext &foldingContext{context.foldingContext()};
105   CookParameters(foldingContext);
106   if (evaluated_) {
107     return;
108   }
109   evaluated_ = true;
110   auto &messages{foldingContext.messages()};
111 
112   // Fold the explicit type parameter value expressions first.  Do not
113   // fold them within the scope of the derived type being instantiated;
114   // these expressions cannot use its type parameters.  Convert the values
115   // of the expressions to the declared types of the type parameters.
116   auto parameterDecls{OrderParameterDeclarations(typeSymbol_)};
117   for (const Symbol &symbol : parameterDecls) {
118     const SourceName &name{symbol.name()};
119     if (ParamValue * paramValue{FindParameter(name)}) {
120       if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) {
121         if (auto converted{evaluate::ConvertToType(symbol, SomeExpr{*expr})}) {
122           SomeExpr folded{
123               evaluate::Fold(foldingContext, std::move(*converted))};
124           if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) {
125             paramValue->SetExplicit(std::move(*intExpr));
126             continue;
127           }
128         }
129         if (!context.HasError(symbol)) {
130           evaluate::SayWithDeclaration(messages, symbol,
131               "Value of type parameter '%s' (%s) is not convertible to its"
132               " type"_err_en_US,
133               name, expr->AsFortran());
134         }
135       }
136     }
137   }
138 
139   // Default initialization expressions for the derived type's parameters
140   // may reference other parameters so long as the declaration precedes the
141   // use in the expression (10.1.12).  This is not necessarily the same
142   // order as "type parameter order" (7.5.3.2).
143   // Type parameter default value expressions are folded in declaration order
144   // within the scope of the derived type so that the values of earlier type
145   // parameters are available for use in the default initialization
146   // expressions of later parameters.
147   auto restorer{foldingContext.WithPDTInstance(*this)};
148   for (const Symbol &symbol : parameterDecls) {
149     const SourceName &name{symbol.name()};
150     if (!FindParameter(name)) {
151       const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
152       if (details.init()) {
153         auto expr{evaluate::Fold(foldingContext, SomeExpr{*details.init()})};
154         AddParamValue(name,
155             ParamValue{
156                 std::move(std::get<SomeIntExpr>(expr.u)), details.attr()});
157       } else if (!context.HasError(symbol)) {
158         messages.Say(name_,
159             "Type parameter '%s' lacks a value and has no default"_err_en_US,
160             name);
161       }
162     }
163   }
164 }
165 
166 void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) {
167   CHECK(cooked_);
168   auto pair{parameters_.insert(std::make_pair(name, std::move(value)))};
169   CHECK(pair.second); // name was not already present
170 }
171 
172 bool DerivedTypeSpec::MightBeParameterized() const {
173   return !cooked_ || !parameters_.empty();
174 }
175 
176 bool DerivedTypeSpec::IsForwardReferenced() const {
177   return typeSymbol_.get<DerivedTypeDetails>().isForwardReferenced();
178 }
179 
180 bool DerivedTypeSpec::HasDefaultInitialization(bool ignoreAllocatable) const {
181   DirectComponentIterator components{*this};
182   return bool{std::find_if(
183       components.begin(), components.end(), [&](const Symbol &component) {
184         return IsInitialized(component, true, ignoreAllocatable);
185       })};
186 }
187 
188 bool DerivedTypeSpec::HasDestruction() const {
189   if (!typeSymbol().get<DerivedTypeDetails>().finals().empty()) {
190     return true;
191   }
192   DirectComponentIterator components{*this};
193   return bool{std::find_if(
194       components.begin(), components.end(), [&](const Symbol &component) {
195         return IsDestructible(component, &typeSymbol());
196       })};
197 }
198 
199 ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
200   return const_cast<ParamValue *>(
201       const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
202 }
203 
204 class InstantiateHelper {
205 public:
206   InstantiateHelper(Scope &scope) : scope_{scope} {}
207   // Instantiate components from fromScope into scope_
208   void InstantiateComponents(const Scope &);
209 
210 private:
211   SemanticsContext &context() const { return scope_.context(); }
212   evaluate::FoldingContext &foldingContext() {
213     return context().foldingContext();
214   }
215   template <typename A> A Fold(A &&expr) {
216     return evaluate::Fold(foldingContext(), std::move(expr));
217   }
218   void InstantiateComponent(const Symbol &);
219   const DeclTypeSpec *InstantiateType(const Symbol &);
220   const DeclTypeSpec &InstantiateIntrinsicType(
221       SourceName, const DeclTypeSpec &);
222   DerivedTypeSpec CreateDerivedTypeSpec(const DerivedTypeSpec &, bool);
223 
224   Scope &scope_;
225 };
226 
227 static int PlumbPDTInstantiationDepth(const Scope *scope) {
228   int depth{0};
229   while (scope->IsParameterizedDerivedTypeInstantiation()) {
230     ++depth;
231     scope = &scope->parent();
232   }
233   return depth;
234 }
235 
236 // Completes component derived type instantiation and initializer folding
237 // for a non-parameterized derived type Scope.
238 static void InstantiateNonPDTScope(Scope &typeScope, Scope &containingScope) {
239   auto &context{containingScope.context()};
240   auto &foldingContext{context.foldingContext()};
241   for (auto &pair : typeScope) {
242     Symbol &symbol{*pair.second};
243     if (DeclTypeSpec * type{symbol.GetType()}) {
244       if (DerivedTypeSpec * derived{type->AsDerived()}) {
245         if (!(derived->IsForwardReferenced() &&
246                 IsAllocatableOrPointer(symbol))) {
247           derived->Instantiate(containingScope);
248         }
249       }
250     }
251     if (!IsPointer(symbol)) {
252       if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
253         if (MaybeExpr & init{object->init()}) {
254           auto restorer{foldingContext.messages().SetLocation(symbol.name())};
255           init = evaluate::NonPointerInitializationExpr(
256               symbol, std::move(*init), foldingContext);
257         }
258       }
259     }
260   }
261   ComputeOffsets(context, typeScope);
262 }
263 
264 void DerivedTypeSpec::Instantiate(Scope &containingScope) {
265   if (instantiated_) {
266     return;
267   }
268   instantiated_ = true;
269   auto &context{containingScope.context()};
270   auto &foldingContext{context.foldingContext()};
271   if (IsForwardReferenced()) {
272     foldingContext.messages().Say(typeSymbol_.name(),
273         "The derived type '%s' was forward-referenced but not defined"_err_en_US,
274         typeSymbol_.name());
275     context.SetError(typeSymbol_);
276     return;
277   }
278   EvaluateParameters(context);
279   const Scope &typeScope{DEREF(typeSymbol_.scope())};
280   if (!MightBeParameterized()) {
281     scope_ = &typeScope;
282     if (typeScope.derivedTypeSpec()) {
283       CHECK(*this == *typeScope.derivedTypeSpec());
284     } else {
285       Scope &mutableTypeScope{const_cast<Scope &>(typeScope)};
286       mutableTypeScope.set_derivedTypeSpec(*this);
287       InstantiateNonPDTScope(mutableTypeScope, containingScope);
288     }
289     return;
290   }
291   // New PDT instantiation.  Create a new scope and populate it
292   // with components that have been specialized for this set of
293   // parameters.
294   Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
295   newScope.set_derivedTypeSpec(*this);
296   ReplaceScope(newScope);
297   auto restorer{foldingContext.WithPDTInstance(*this)};
298   std::string desc{typeSymbol_.name().ToString()};
299   char sep{'('};
300   for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
301     const SourceName &name{symbol.name()};
302     if (typeScope.find(symbol.name()) != typeScope.end()) {
303       // This type parameter belongs to the derived type itself, not to
304       // one of its ancestors.  Put the type parameter expression value
305       // into the new scope as the initialization value for the parameter.
306       if (ParamValue * paramValue{FindParameter(name)}) {
307         const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
308         paramValue->set_attr(details.attr());
309         if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
310           if (auto folded{evaluate::NonPointerInitializationExpr(symbol,
311                   SomeExpr{std::move(*expr)}, foldingContext, &newScope)}) {
312             desc += sep;
313             desc += name.ToString();
314             desc += '=';
315             desc += folded->AsFortran();
316             sep = ',';
317             TypeParamDetails instanceDetails{details.attr()};
318             if (const DeclTypeSpec * type{details.type()}) {
319               instanceDetails.set_type(*type);
320             }
321             instanceDetails.set_init(
322                 std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*folded))));
323             newScope.try_emplace(name, std::move(instanceDetails));
324           }
325         }
326       }
327     }
328   }
329   parser::Message *contextMessage{nullptr};
330   if (sep != '(') {
331     desc += ')';
332     contextMessage = new parser::Message{foldingContext.messages().at(),
333         "instantiation of parameterized derived type '%s'"_en_US, desc};
334     if (auto outer{containingScope.instantiationContext()}) {
335       contextMessage->SetContext(outer.get());
336     }
337     newScope.set_instantiationContext(contextMessage);
338   }
339   // Instantiate every non-parameter symbol from the original derived
340   // type's scope into the new instance.
341   newScope.AddSourceRange(typeScope.sourceRange());
342   auto restorer2{foldingContext.messages().SetContext(contextMessage)};
343   if (PlumbPDTInstantiationDepth(&containingScope) > 100) {
344     foldingContext.messages().Say(
345         "Too many recursive parameterized derived type instantiations"_err_en_US);
346   } else {
347     InstantiateHelper{newScope}.InstantiateComponents(typeScope);
348   }
349 }
350 
351 void InstantiateHelper::InstantiateComponents(const Scope &fromScope) {
352   for (const auto &pair : fromScope) {
353     InstantiateComponent(*pair.second);
354   }
355   ComputeOffsets(context(), scope_);
356 }
357 
358 void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
359   auto pair{scope_.try_emplace(
360       oldSymbol.name(), oldSymbol.attrs(), common::Clone(oldSymbol.details()))};
361   Symbol &newSymbol{*pair.first->second};
362   if (!pair.second) {
363     // Symbol was already present in the scope, which can only happen
364     // in the case of type parameters.
365     CHECK(oldSymbol.has<TypeParamDetails>());
366     return;
367   }
368   newSymbol.flags() = oldSymbol.flags();
369   if (auto *details{newSymbol.detailsIf<ObjectEntityDetails>()}) {
370     if (const DeclTypeSpec * newType{InstantiateType(newSymbol)}) {
371       details->ReplaceType(*newType);
372     }
373     for (ShapeSpec &dim : details->shape()) {
374       if (dim.lbound().isExplicit()) {
375         dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit())));
376       }
377       if (dim.ubound().isExplicit()) {
378         dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit())));
379       }
380     }
381     for (ShapeSpec &dim : details->coshape()) {
382       if (dim.lbound().isExplicit()) {
383         dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit())));
384       }
385       if (dim.ubound().isExplicit()) {
386         dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit())));
387       }
388     }
389     if (MaybeExpr & init{details->init()}) {
390       // Non-pointer components with default initializers are
391       // processed now so that those default initializers can be used
392       // in PARAMETER structure constructors.
393       auto restorer{foldingContext().messages().SetLocation(newSymbol.name())};
394       init = IsPointer(newSymbol)
395           ? Fold(std::move(*init))
396           : evaluate::NonPointerInitializationExpr(
397                 newSymbol, std::move(*init), foldingContext());
398     }
399   } else if (auto *procDetails{newSymbol.detailsIf<ProcEntityDetails>()}) {
400     // We have a procedure pointer.  Instantiate its return type
401     if (const DeclTypeSpec * returnType{InstantiateType(newSymbol)}) {
402       ProcInterface &interface{procDetails->interface()};
403       if (!interface.symbol()) {
404         // Don't change the type for interfaces based on symbols
405         interface.set_type(*returnType);
406       }
407     }
408   }
409 }
410 
411 const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) {
412   const DeclTypeSpec *type{symbol.GetType()};
413   if (!type) {
414     return nullptr; // error has occurred
415   } else if (const DerivedTypeSpec * spec{type->AsDerived()}) {
416     return &FindOrInstantiateDerivedType(scope_,
417         CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)),
418         type->category());
419   } else if (type->AsIntrinsic()) {
420     return &InstantiateIntrinsicType(symbol.name(), *type);
421   } else if (type->category() == DeclTypeSpec::ClassStar) {
422     return type;
423   } else {
424     common::die("InstantiateType: %s", type->AsFortran().c_str());
425   }
426 }
427 
428 /// Fold explicit length parameters of character components when the explicit
429 /// expression is a constant expression (if it only depends on KIND parameters).
430 /// Do not fold `character(len=pdt_length)`, even if the length parameter is
431 /// constant in the pdt instantiation, in order to avoid losing the information
432 /// that the character component is automatic (and must be a descriptor).
433 static ParamValue FoldCharacterLength(evaluate::FoldingContext &foldingContext,
434     const CharacterTypeSpec &characterSpec) {
435   if (const auto &len{characterSpec.length().GetExplicit()}) {
436     if (evaluate::IsConstantExpr(*len)) {
437       return ParamValue{evaluate::Fold(foldingContext, common::Clone(*len)),
438           common::TypeParamAttr::Len};
439     }
440   }
441   return characterSpec.length();
442 }
443 
444 // Apply type parameter values to an intrinsic type spec.
445 const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
446     SourceName symbolName, const DeclTypeSpec &spec) {
447   const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())};
448   if (spec.category() != DeclTypeSpec::Character &&
449       evaluate::IsActuallyConstant(intrinsic.kind())) {
450     return spec; // KIND is already a known constant
451   }
452   // The expression was not originally constant, but now it must be so
453   // in the context of a parameterized derived type instantiation.
454   KindExpr copy{Fold(common::Clone(intrinsic.kind()))};
455   int kind{context().GetDefaultKind(intrinsic.category())};
456   if (auto value{evaluate::ToInt64(copy)}) {
457     if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) {
458       kind = *value;
459     } else {
460       foldingContext().messages().Say(symbolName,
461           "KIND parameter value (%jd) of intrinsic type %s "
462           "did not resolve to a supported value"_err_en_US,
463           *value,
464           parser::ToUpperCaseLetters(EnumToString(intrinsic.category())));
465     }
466   }
467   switch (spec.category()) {
468   case DeclTypeSpec::Numeric:
469     return scope_.MakeNumericType(intrinsic.category(), KindExpr{kind});
470   case DeclTypeSpec::Logical:
471     return scope_.MakeLogicalType(KindExpr{kind});
472   case DeclTypeSpec::Character:
473     return scope_.MakeCharacterType(
474         FoldCharacterLength(foldingContext(), spec.characterTypeSpec()),
475         KindExpr{kind});
476   default:
477     CRASH_NO_CASE;
478   }
479 }
480 
481 DerivedTypeSpec InstantiateHelper::CreateDerivedTypeSpec(
482     const DerivedTypeSpec &spec, bool isParentComp) {
483   DerivedTypeSpec result{spec};
484   result.CookParameters(foldingContext()); // enables AddParamValue()
485   if (isParentComp) {
486     // Forward any explicit type parameter values from the
487     // derived type spec under instantiation that define type parameters
488     // of the parent component to the derived type spec of the
489     // parent component.
490     const DerivedTypeSpec &instanceSpec{DEREF(foldingContext().pdtInstance())};
491     for (const auto &[name, value] : instanceSpec.parameters()) {
492       if (scope_.find(name) == scope_.end()) {
493         result.AddParamValue(name, ParamValue{value});
494       }
495     }
496   }
497   return result;
498 }
499 
500 std::string DerivedTypeSpec::AsFortran() const {
501   std::string buf;
502   llvm::raw_string_ostream ss{buf};
503   ss << name_;
504   if (!rawParameters_.empty()) {
505     CHECK(parameters_.empty());
506     ss << '(';
507     bool first = true;
508     for (const auto &[maybeKeyword, value] : rawParameters_) {
509       if (first) {
510         first = false;
511       } else {
512         ss << ',';
513       }
514       if (maybeKeyword) {
515         ss << maybeKeyword->v.source.ToString() << '=';
516       }
517       ss << value.AsFortran();
518     }
519     ss << ')';
520   } else if (!parameters_.empty()) {
521     ss << '(';
522     bool first = true;
523     for (const auto &[name, value] : parameters_) {
524       if (first) {
525         first = false;
526       } else {
527         ss << ',';
528       }
529       ss << name.ToString() << '=' << value.AsFortran();
530     }
531     ss << ')';
532   }
533   return ss.str();
534 }
535 
536 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) {
537   return o << x.AsFortran();
538 }
539 
540 Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {}
541 
542 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) {
543   if (x.isStar()) {
544     o << '*';
545   } else if (x.isColon()) {
546     o << ':';
547   } else if (x.expr_) {
548     x.expr_->AsFortran(o);
549   } else {
550     o << "<no-expr>";
551   }
552   return o;
553 }
554 
555 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ShapeSpec &x) {
556   if (x.lb_.isStar()) {
557     CHECK(x.ub_.isStar());
558     o << "..";
559   } else {
560     if (!x.lb_.isColon()) {
561       o << x.lb_;
562     }
563     o << ':';
564     if (!x.ub_.isColon()) {
565       o << x.ub_;
566     }
567   }
568   return o;
569 }
570 
571 llvm::raw_ostream &operator<<(
572     llvm::raw_ostream &os, const ArraySpec &arraySpec) {
573   char sep{'('};
574   for (auto &shape : arraySpec) {
575     os << sep << shape;
576     sep = ',';
577   }
578   if (sep == ',') {
579     os << ')';
580   }
581   return os;
582 }
583 
584 ParamValue::ParamValue(MaybeIntExpr &&expr, common::TypeParamAttr attr)
585     : attr_{attr}, expr_{std::move(expr)} {}
586 ParamValue::ParamValue(SomeIntExpr &&expr, common::TypeParamAttr attr)
587     : attr_{attr}, expr_{std::move(expr)} {}
588 ParamValue::ParamValue(
589     common::ConstantSubscript value, common::TypeParamAttr attr)
590     : ParamValue(SomeIntExpr{evaluate::Expr<evaluate::SubscriptInteger>{value}},
591           attr) {}
592 
593 void ParamValue::SetExplicit(SomeIntExpr &&x) {
594   category_ = Category::Explicit;
595   expr_ = std::move(x);
596 }
597 
598 std::string ParamValue::AsFortran() const {
599   switch (category_) {
600     SWITCH_COVERS_ALL_CASES
601   case Category::Assumed:
602     return "*";
603   case Category::Deferred:
604     return ":";
605   case Category::Explicit:
606     if (expr_) {
607       std::string buf;
608       llvm::raw_string_ostream ss{buf};
609       expr_->AsFortran(ss);
610       return ss.str();
611     } else {
612       return "";
613     }
614   }
615 }
616 
617 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ParamValue &x) {
618   return o << x.AsFortran();
619 }
620 
621 IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, KindExpr &&kind)
622     : category_{category}, kind_{std::move(kind)} {
623   CHECK(category != TypeCategory::Derived);
624 }
625 
626 static std::string KindAsFortran(const KindExpr &kind) {
627   std::string buf;
628   llvm::raw_string_ostream ss{buf};
629   if (auto k{evaluate::ToInt64(kind)}) {
630     ss << *k; // emit unsuffixed kind code
631   } else {
632     kind.AsFortran(ss);
633   }
634   return ss.str();
635 }
636 
637 std::string IntrinsicTypeSpec::AsFortran() const {
638   return parser::ToUpperCaseLetters(common::EnumToString(category_)) + '(' +
639       KindAsFortran(kind_) + ')';
640 }
641 
642 llvm::raw_ostream &operator<<(
643     llvm::raw_ostream &os, const IntrinsicTypeSpec &x) {
644   return os << x.AsFortran();
645 }
646 
647 std::string CharacterTypeSpec::AsFortran() const {
648   return "CHARACTER(" + length_.AsFortran() + ',' + KindAsFortran(kind()) + ')';
649 }
650 
651 llvm::raw_ostream &operator<<(
652     llvm::raw_ostream &os, const CharacterTypeSpec &x) {
653   return os << x.AsFortran();
654 }
655 
656 DeclTypeSpec::DeclTypeSpec(NumericTypeSpec &&typeSpec)
657     : category_{Numeric}, typeSpec_{std::move(typeSpec)} {}
658 DeclTypeSpec::DeclTypeSpec(LogicalTypeSpec &&typeSpec)
659     : category_{Logical}, typeSpec_{std::move(typeSpec)} {}
660 DeclTypeSpec::DeclTypeSpec(const CharacterTypeSpec &typeSpec)
661     : category_{Character}, typeSpec_{typeSpec} {}
662 DeclTypeSpec::DeclTypeSpec(CharacterTypeSpec &&typeSpec)
663     : category_{Character}, typeSpec_{std::move(typeSpec)} {}
664 DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec)
665     : category_{category}, typeSpec_{typeSpec} {
666   CHECK(category == TypeDerived || category == ClassDerived);
667 }
668 DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &&typeSpec)
669     : category_{category}, typeSpec_{std::move(typeSpec)} {
670   CHECK(category == TypeDerived || category == ClassDerived);
671 }
672 DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} {
673   CHECK(category == TypeStar || category == ClassStar);
674 }
675 bool DeclTypeSpec::IsNumeric(TypeCategory tc) const {
676   return category_ == Numeric && numericTypeSpec().category() == tc;
677 }
678 bool DeclTypeSpec::IsSequenceType() const {
679   if (const DerivedTypeSpec * derivedType{AsDerived()}) {
680     const auto *typeDetails{
681         derivedType->typeSymbol().detailsIf<DerivedTypeDetails>()};
682     return typeDetails && typeDetails->sequence();
683   }
684   return false;
685 }
686 
687 const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const {
688   CHECK(category_ == Numeric);
689   return std::get<NumericTypeSpec>(typeSpec_);
690 }
691 const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const {
692   CHECK(category_ == Logical);
693   return std::get<LogicalTypeSpec>(typeSpec_);
694 }
695 bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const {
696   return category_ == that.category_ && typeSpec_ == that.typeSpec_;
697 }
698 
699 std::string DeclTypeSpec::AsFortran() const {
700   switch (category_) {
701     SWITCH_COVERS_ALL_CASES
702   case Numeric:
703     return numericTypeSpec().AsFortran();
704   case Logical:
705     return logicalTypeSpec().AsFortran();
706   case Character:
707     return characterTypeSpec().AsFortran();
708   case TypeDerived:
709     if (derivedTypeSpec()
710             .typeSymbol()
711             .get<DerivedTypeDetails>()
712             .isDECStructure()) {
713       return "RECORD" + derivedTypeSpec().typeSymbol().name().ToString();
714     } else {
715       return "TYPE(" + derivedTypeSpec().AsFortran() + ')';
716     }
717   case ClassDerived:
718     return "CLASS(" + derivedTypeSpec().AsFortran() + ')';
719   case TypeStar:
720     return "TYPE(*)";
721   case ClassStar:
722     return "CLASS(*)";
723   }
724 }
725 
726 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) {
727   return o << x.AsFortran();
728 }
729 
730 void ProcInterface::set_symbol(const Symbol &symbol) {
731   CHECK(!type_);
732   symbol_ = &symbol;
733 }
734 void ProcInterface::set_type(const DeclTypeSpec &type) {
735   CHECK(!symbol_);
736   type_ = &type;
737 }
738 
739 } // namespace Fortran::semantics
740