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