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     context.SetError(typeSymbol_);
248     return;
249   }
250   EvaluateParameters(context);
251   const Scope &typeScope{DEREF(typeSymbol_.scope())};
252   if (!MightBeParameterized()) {
253     scope_ = &typeScope;
254     for (auto &pair : typeScope) {
255       Symbol &symbol{*pair.second};
256       if (DeclTypeSpec * type{symbol.GetType()}) {
257         if (DerivedTypeSpec * derived{type->AsDerived()}) {
258           if (!(derived->IsForwardReferenced() &&
259                   IsAllocatableOrPointer(symbol))) {
260             derived->Instantiate(containingScope);
261           }
262         }
263       }
264       if (!IsPointer(symbol)) {
265         if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
266           if (MaybeExpr & init{object->init()}) {
267             auto restorer{foldingContext.messages().SetLocation(symbol.name())};
268             init = evaluate::NonPointerInitializationExpr(
269                 symbol, std::move(*init), foldingContext);
270           }
271         }
272       }
273     }
274     ComputeOffsets(context, const_cast<Scope &>(typeScope));
275     return;
276   }
277   // New PDT instantiation.  Create a new scope and populate it
278   // with components that have been specialized for this set of
279   // parameters.
280   Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
281   newScope.set_derivedTypeSpec(*this);
282   ReplaceScope(newScope);
283   auto restorer{foldingContext.WithPDTInstance(*this)};
284   std::string desc{typeSymbol_.name().ToString()};
285   char sep{'('};
286   for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
287     const SourceName &name{symbol.name()};
288     if (typeScope.find(symbol.name()) != typeScope.end()) {
289       // This type parameter belongs to the derived type itself, not to
290       // one of its ancestors.  Put the type parameter expression value
291       // into the new scope as the initialization value for the parameter.
292       if (ParamValue * paramValue{FindParameter(name)}) {
293         const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
294         paramValue->set_attr(details.attr());
295         if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
296           if (auto folded{evaluate::NonPointerInitializationExpr(symbol,
297                   SomeExpr{std::move(*expr)}, foldingContext, &newScope)}) {
298             desc += sep;
299             desc += name.ToString();
300             desc += '=';
301             desc += folded->AsFortran();
302             sep = ',';
303             TypeParamDetails instanceDetails{details.attr()};
304             if (const DeclTypeSpec * type{details.type()}) {
305               instanceDetails.set_type(*type);
306             }
307             instanceDetails.set_init(
308                 std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*folded))));
309             newScope.try_emplace(name, std::move(instanceDetails));
310           }
311         }
312       }
313     }
314   }
315   parser::Message *contextMessage{nullptr};
316   if (sep != '(') {
317     desc += ')';
318     contextMessage = new parser::Message{foldingContext.messages().at(),
319         "instantiation of parameterized derived type '%s'"_en_US, desc};
320     if (auto outer{containingScope.instantiationContext()}) {
321       contextMessage->SetContext(outer.get());
322     }
323     newScope.set_instantiationContext(contextMessage);
324   }
325   // Instantiate every non-parameter symbol from the original derived
326   // type's scope into the new instance.
327   newScope.AddSourceRange(typeScope.sourceRange());
328   auto restorer2{foldingContext.messages().SetContext(contextMessage)};
329   if (PlumbPDTInstantiationDepth(&containingScope) > 100) {
330     foldingContext.messages().Say(
331         "Too many recursive parameterized derived type instantiations"_err_en_US);
332   } else {
333     InstantiateHelper{newScope}.InstantiateComponents(typeScope);
334   }
335 }
336 
337 void InstantiateHelper::InstantiateComponents(const Scope &fromScope) {
338   for (const auto &pair : fromScope) {
339     InstantiateComponent(*pair.second);
340   }
341   ComputeOffsets(context(), scope_);
342 }
343 
344 void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
345   auto pair{scope_.try_emplace(
346       oldSymbol.name(), oldSymbol.attrs(), common::Clone(oldSymbol.details()))};
347   Symbol &newSymbol{*pair.first->second};
348   if (!pair.second) {
349     // Symbol was already present in the scope, which can only happen
350     // in the case of type parameters.
351     CHECK(oldSymbol.has<TypeParamDetails>());
352     return;
353   }
354   newSymbol.flags() = oldSymbol.flags();
355   if (auto *details{newSymbol.detailsIf<ObjectEntityDetails>()}) {
356     if (const DeclTypeSpec * newType{InstantiateType(newSymbol)}) {
357       details->ReplaceType(*newType);
358     }
359     for (ShapeSpec &dim : details->shape()) {
360       if (dim.lbound().isExplicit()) {
361         dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit())));
362       }
363       if (dim.ubound().isExplicit()) {
364         dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit())));
365       }
366     }
367     for (ShapeSpec &dim : details->coshape()) {
368       if (dim.lbound().isExplicit()) {
369         dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit())));
370       }
371       if (dim.ubound().isExplicit()) {
372         dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit())));
373       }
374     }
375     if (MaybeExpr & init{details->init()}) {
376       // Non-pointer components with default initializers are
377       // processed now so that those default initializers can be used
378       // in PARAMETER structure constructors.
379       auto restorer{foldingContext().messages().SetLocation(newSymbol.name())};
380       init = IsPointer(newSymbol)
381           ? Fold(std::move(*init))
382           : evaluate::NonPointerInitializationExpr(
383                 newSymbol, std::move(*init), foldingContext());
384     }
385   } else if (auto *procDetails{newSymbol.detailsIf<ProcEntityDetails>()}) {
386     // We have a procedure pointer.  Instantiate its return type
387     if (const DeclTypeSpec * returnType{InstantiateType(newSymbol)}) {
388       ProcInterface &interface{procDetails->interface()};
389       if (!interface.symbol()) {
390         // Don't change the type for interfaces based on symbols
391         interface.set_type(*returnType);
392       }
393     }
394   }
395 }
396 
397 const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) {
398   const DeclTypeSpec *type{symbol.GetType()};
399   if (!type) {
400     return nullptr; // error has occurred
401   } else if (const DerivedTypeSpec * spec{type->AsDerived()}) {
402     return &FindOrInstantiateDerivedType(scope_,
403         CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)),
404         type->category());
405   } else if (type->AsIntrinsic()) {
406     return &InstantiateIntrinsicType(symbol.name(), *type);
407   } else if (type->category() == DeclTypeSpec::ClassStar) {
408     return type;
409   } else {
410     common::die("InstantiateType: %s", type->AsFortran().c_str());
411   }
412 }
413 
414 // Apply type parameter values to an intrinsic type spec.
415 const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
416     SourceName symbolName, const DeclTypeSpec &spec) {
417   const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())};
418   if (evaluate::ToInt64(intrinsic.kind())) {
419     return spec; // KIND is already a known constant
420   }
421   // The expression was not originally constant, but now it must be so
422   // in the context of a parameterized derived type instantiation.
423   KindExpr copy{Fold(common::Clone(intrinsic.kind()))};
424   int kind{context().GetDefaultKind(intrinsic.category())};
425   if (auto value{evaluate::ToInt64(copy)}) {
426     if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) {
427       kind = *value;
428     } else {
429       foldingContext().messages().Say(symbolName,
430           "KIND parameter value (%jd) of intrinsic type %s "
431           "did not resolve to a supported value"_err_en_US,
432           *value,
433           parser::ToUpperCaseLetters(EnumToString(intrinsic.category())));
434     }
435   }
436   switch (spec.category()) {
437   case DeclTypeSpec::Numeric:
438     return scope_.MakeNumericType(intrinsic.category(), KindExpr{kind});
439   case DeclTypeSpec::Logical:
440     return scope_.MakeLogicalType(KindExpr{kind});
441   case DeclTypeSpec::Character:
442     return scope_.MakeCharacterType(
443         ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind});
444   default:
445     CRASH_NO_CASE;
446   }
447 }
448 
449 DerivedTypeSpec InstantiateHelper::CreateDerivedTypeSpec(
450     const DerivedTypeSpec &spec, bool isParentComp) {
451   DerivedTypeSpec result{spec};
452   result.CookParameters(foldingContext()); // enables AddParamValue()
453   if (isParentComp) {
454     // Forward any explicit type parameter values from the
455     // derived type spec under instantiation that define type parameters
456     // of the parent component to the derived type spec of the
457     // parent component.
458     const DerivedTypeSpec &instanceSpec{DEREF(foldingContext().pdtInstance())};
459     for (const auto &[name, value] : instanceSpec.parameters()) {
460       if (scope_.find(name) == scope_.end()) {
461         result.AddParamValue(name, ParamValue{value});
462       }
463     }
464   }
465   return result;
466 }
467 
468 std::string DerivedTypeSpec::AsFortran() const {
469   std::string buf;
470   llvm::raw_string_ostream ss{buf};
471   ss << name_;
472   if (!rawParameters_.empty()) {
473     CHECK(parameters_.empty());
474     ss << '(';
475     bool first = true;
476     for (const auto &[maybeKeyword, value] : rawParameters_) {
477       if (first) {
478         first = false;
479       } else {
480         ss << ',';
481       }
482       if (maybeKeyword) {
483         ss << maybeKeyword->v.source.ToString() << '=';
484       }
485       ss << value.AsFortran();
486     }
487     ss << ')';
488   } else if (!parameters_.empty()) {
489     ss << '(';
490     bool first = true;
491     for (const auto &[name, value] : parameters_) {
492       if (first) {
493         first = false;
494       } else {
495         ss << ',';
496       }
497       ss << name.ToString() << '=' << value.AsFortran();
498     }
499     ss << ')';
500   }
501   return ss.str();
502 }
503 
504 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) {
505   return o << x.AsFortran();
506 }
507 
508 Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {}
509 
510 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) {
511   if (x.isAssumed()) {
512     o << '*';
513   } else if (x.isDeferred()) {
514     o << ':';
515   } else if (x.expr_) {
516     x.expr_->AsFortran(o);
517   } else {
518     o << "<no-expr>";
519   }
520   return o;
521 }
522 
523 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ShapeSpec &x) {
524   if (x.lb_.isAssumed()) {
525     CHECK(x.ub_.isAssumed());
526     o << "..";
527   } else {
528     if (!x.lb_.isDeferred()) {
529       o << x.lb_;
530     }
531     o << ':';
532     if (!x.ub_.isDeferred()) {
533       o << x.ub_;
534     }
535   }
536   return o;
537 }
538 
539 llvm::raw_ostream &operator<<(
540     llvm::raw_ostream &os, const ArraySpec &arraySpec) {
541   char sep{'('};
542   for (auto &shape : arraySpec) {
543     os << sep << shape;
544     sep = ',';
545   }
546   if (sep == ',') {
547     os << ')';
548   }
549   return os;
550 }
551 
552 ParamValue::ParamValue(MaybeIntExpr &&expr, common::TypeParamAttr attr)
553     : attr_{attr}, expr_{std::move(expr)} {}
554 ParamValue::ParamValue(SomeIntExpr &&expr, common::TypeParamAttr attr)
555     : attr_{attr}, expr_{std::move(expr)} {}
556 ParamValue::ParamValue(
557     common::ConstantSubscript value, common::TypeParamAttr attr)
558     : ParamValue(SomeIntExpr{evaluate::Expr<evaluate::SubscriptInteger>{value}},
559           attr) {}
560 
561 void ParamValue::SetExplicit(SomeIntExpr &&x) {
562   category_ = Category::Explicit;
563   expr_ = std::move(x);
564 }
565 
566 std::string ParamValue::AsFortran() const {
567   switch (category_) {
568     SWITCH_COVERS_ALL_CASES
569   case Category::Assumed:
570     return "*";
571   case Category::Deferred:
572     return ":";
573   case Category::Explicit:
574     if (expr_) {
575       std::string buf;
576       llvm::raw_string_ostream ss{buf};
577       expr_->AsFortran(ss);
578       return ss.str();
579     } else {
580       return "";
581     }
582   }
583 }
584 
585 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ParamValue &x) {
586   return o << x.AsFortran();
587 }
588 
589 IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, KindExpr &&kind)
590     : category_{category}, kind_{std::move(kind)} {
591   CHECK(category != TypeCategory::Derived);
592 }
593 
594 static std::string KindAsFortran(const KindExpr &kind) {
595   std::string buf;
596   llvm::raw_string_ostream ss{buf};
597   if (auto k{evaluate::ToInt64(kind)}) {
598     ss << *k; // emit unsuffixed kind code
599   } else {
600     kind.AsFortran(ss);
601   }
602   return ss.str();
603 }
604 
605 std::string IntrinsicTypeSpec::AsFortran() const {
606   return parser::ToUpperCaseLetters(common::EnumToString(category_)) + '(' +
607       KindAsFortran(kind_) + ')';
608 }
609 
610 llvm::raw_ostream &operator<<(
611     llvm::raw_ostream &os, const IntrinsicTypeSpec &x) {
612   return os << x.AsFortran();
613 }
614 
615 std::string CharacterTypeSpec::AsFortran() const {
616   return "CHARACTER(" + length_.AsFortran() + ',' + KindAsFortran(kind()) + ')';
617 }
618 
619 llvm::raw_ostream &operator<<(
620     llvm::raw_ostream &os, const CharacterTypeSpec &x) {
621   return os << x.AsFortran();
622 }
623 
624 DeclTypeSpec::DeclTypeSpec(NumericTypeSpec &&typeSpec)
625     : category_{Numeric}, typeSpec_{std::move(typeSpec)} {}
626 DeclTypeSpec::DeclTypeSpec(LogicalTypeSpec &&typeSpec)
627     : category_{Logical}, typeSpec_{std::move(typeSpec)} {}
628 DeclTypeSpec::DeclTypeSpec(const CharacterTypeSpec &typeSpec)
629     : category_{Character}, typeSpec_{typeSpec} {}
630 DeclTypeSpec::DeclTypeSpec(CharacterTypeSpec &&typeSpec)
631     : category_{Character}, typeSpec_{std::move(typeSpec)} {}
632 DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec)
633     : category_{category}, typeSpec_{typeSpec} {
634   CHECK(category == TypeDerived || category == ClassDerived);
635 }
636 DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &&typeSpec)
637     : category_{category}, typeSpec_{std::move(typeSpec)} {
638   CHECK(category == TypeDerived || category == ClassDerived);
639 }
640 DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} {
641   CHECK(category == TypeStar || category == ClassStar);
642 }
643 bool DeclTypeSpec::IsNumeric(TypeCategory tc) const {
644   return category_ == Numeric && numericTypeSpec().category() == tc;
645 }
646 bool DeclTypeSpec::IsSequenceType() const {
647   if (const DerivedTypeSpec * derivedType{AsDerived()}) {
648     const auto *typeDetails{
649         derivedType->typeSymbol().detailsIf<DerivedTypeDetails>()};
650     return typeDetails && typeDetails->sequence();
651   }
652   return false;
653 }
654 
655 const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const {
656   CHECK(category_ == Numeric);
657   return std::get<NumericTypeSpec>(typeSpec_);
658 }
659 const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const {
660   CHECK(category_ == Logical);
661   return std::get<LogicalTypeSpec>(typeSpec_);
662 }
663 bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const {
664   return category_ == that.category_ && typeSpec_ == that.typeSpec_;
665 }
666 
667 std::string DeclTypeSpec::AsFortran() const {
668   switch (category_) {
669     SWITCH_COVERS_ALL_CASES
670   case Numeric:
671     return numericTypeSpec().AsFortran();
672   case Logical:
673     return logicalTypeSpec().AsFortran();
674   case Character:
675     return characterTypeSpec().AsFortran();
676   case TypeDerived:
677     return "TYPE(" + derivedTypeSpec().AsFortran() + ')';
678   case ClassDerived:
679     return "CLASS(" + derivedTypeSpec().AsFortran() + ')';
680   case TypeStar:
681     return "TYPE(*)";
682   case ClassStar:
683     return "CLASS(*)";
684   }
685 }
686 
687 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) {
688   return o << x.AsFortran();
689 }
690 
691 void ProcInterface::set_symbol(const Symbol &symbol) {
692   CHECK(!type_);
693   symbol_ = &symbol;
694 }
695 void ProcInterface::set_type(const DeclTypeSpec &type) {
696   CHECK(!symbol_);
697   type_ = &type;
698 }
699 
700 } // namespace Fortran::semantics
701