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