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