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