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