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