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/Common/type-kinds.h" |
13 | #include "flang/Evaluate/fold.h" |
14 | #include "flang/Evaluate/tools.h" |
15 | #include "flang/Evaluate/type.h" |
16 | #include "flang/Parser/characters.h" |
17 | #include "flang/Parser/parse-tree-visitor.h" |
18 | #include "flang/Semantics/scope.h" |
19 | #include "flang/Semantics/symbol.h" |
20 | #include "flang/Semantics/tools.h" |
21 | #include "llvm/Support/raw_ostream.h" |
22 | |
23 | namespace Fortran::semantics { |
24 | |
25 | DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol) |
26 | : name_{name}, originalTypeSymbol_{typeSymbol}, |
27 | typeSymbol_{typeSymbol.GetUltimate()} { |
28 | CHECK(typeSymbol_.has<DerivedTypeDetails>()); |
29 | } |
30 | DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default; |
31 | DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) = default; |
32 | |
33 | void DerivedTypeSpec::set_scope(const Scope &scope) { |
34 | CHECK(!scope_); |
35 | ReplaceScope(scope); |
36 | } |
37 | void DerivedTypeSpec::ReplaceScope(const Scope &scope) { |
38 | CHECK(scope.IsDerivedType()); |
39 | scope_ = &scope; |
40 | } |
41 | |
42 | const Scope *DerivedTypeSpec::GetScope() const { |
43 | return scope_ ? scope_ : typeSymbol_.scope(); |
44 | } |
45 | |
46 | void DerivedTypeSpec::AddRawParamValue( |
47 | const parser::Keyword *keyword, ParamValue &&value) { |
48 | CHECK(parameters_.empty()); |
49 | rawParameters_.emplace_back(keyword, std::move(value)); |
50 | } |
51 | |
52 | void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) { |
53 | if (cooked_) { |
54 | return; |
55 | } |
56 | cooked_ = true; |
57 | auto &messages{foldingContext.messages()}; |
58 | if (IsForwardReferenced()) { |
59 | messages.Say(typeSymbol_.name(), |
60 | "Derived type '%s' was used but never defined"_err_en_US, |
61 | typeSymbol_.name()); |
62 | return; |
63 | } |
64 | |
65 | // Parameters of the most deeply nested "base class" come first when the |
66 | // derived type is an extension. |
67 | auto parameterNames{OrderParameterNames(typeSymbol_)}; |
68 | auto nextNameIter{parameterNames.begin()}; |
69 | RawParameters raw{std::move(rawParameters_)}; |
70 | for (auto &[maybeKeyword, value] : raw) { |
71 | SourceName name; |
72 | common::TypeParamAttr attr{common::TypeParamAttr::Kind}; |
73 | if (maybeKeyword) { |
74 | name = maybeKeyword->v.source; |
75 | auto it{std::find_if(parameterNames.begin(), parameterNames.end(), |
76 | [&](const Symbol &symbol) { return symbol.name() == name; })}; |
77 | if (it == parameterNames.end()) { |
78 | messages.Say(name, |
79 | "'%s' is not the name of a parameter for derived type '%s'"_err_en_US, |
80 | name, typeSymbol_.name()); |
81 | } else { |
82 | // Resolve the keyword's symbol |
83 | maybeKeyword->v.symbol = const_cast<Symbol *>(&it->get()); |
84 | if (const auto *tpd{it->get().detailsIf<TypeParamDetails>()}) { |
85 | attr = tpd->attr().value_or(attr); |
86 | } |
87 | } |
88 | } else if (nextNameIter != parameterNames.end()) { |
89 | name = nextNameIter->get().name(); |
90 | if (const auto *tpd{nextNameIter->get().detailsIf<TypeParamDetails>()}) { |
91 | attr = tpd->attr().value_or(attr); |
92 | } |
93 | ++nextNameIter; |
94 | } else { |
95 | messages.Say(name_, |
96 | "Too many type parameters given for derived type '%s'"_err_en_US, |
97 | typeSymbol_.name()); |
98 | break; |
99 | } |
100 | if (FindParameter(name)) { |
101 | messages.Say(name_, |
102 | "Multiple values given for type parameter '%s'"_err_en_US, name); |
103 | } else { |
104 | value.set_attr(attr); |
105 | AddParamValue(name, std::move(value)); |
106 | } |
107 | } |
108 | } |
109 | |
110 | void DerivedTypeSpec::EvaluateParameters(SemanticsContext &context) { |
111 | evaluate::FoldingContext &foldingContext{context.foldingContext()}; |
112 | CookParameters(foldingContext); |
113 | if (evaluated_) { |
114 | return; |
115 | } |
116 | evaluated_ = true; |
117 | auto &messages{foldingContext.messages()}; |
118 | for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) { |
119 | SourceName name{symbol.name()}; |
120 | int parameterKind{evaluate::TypeParamInquiry::Result::kind}; |
121 | // Compute the integer kind value of the type parameter, |
122 | // which may depend on the values of earlier ones. |
123 | if (const auto *typeSpec{symbol.GetType()}) { |
124 | if (const IntrinsicTypeSpec * intrinType{typeSpec->AsIntrinsic()}; |
125 | intrinType && intrinType->category() == TypeCategory::Integer) { |
126 | auto restorer{foldingContext.WithPDTInstance(*this)}; |
127 | auto folded{Fold(foldingContext, KindExpr{intrinType->kind()})}; |
128 | if (auto k{evaluate::ToInt64(folded)}; k && |
129 | common::IsValidKindOfIntrinsicType(TypeCategory::Integer, *k)) { |
130 | parameterKind = static_cast<int>(*k); |
131 | } else { |
132 | messages.Say( |
133 | "Type of type parameter '%s' (%s) is not a valid kind of INTEGER"_err_en_US, |
134 | name, intrinType->kind().AsFortran()); |
135 | } |
136 | } |
137 | } |
138 | bool ok{ |
139 | symbol.get<TypeParamDetails>().attr() == common::TypeParamAttr::Len}; |
140 | if (ParamValue * paramValue{FindParameter(name)}) { |
141 | // Explicit type parameter value expressions are not folded within |
142 | // the scope of the derived type being instantiated, as the expressions |
143 | // themselves are not in that scope and cannot reference its type |
144 | // parameters. |
145 | if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) { |
146 | evaluate::DynamicType dyType{TypeCategory::Integer, parameterKind}; |
147 | if (auto converted{evaluate::ConvertToType(dyType, SomeExpr{*expr})}) { |
148 | SomeExpr folded{ |
149 | evaluate::Fold(foldingContext, std::move(*converted))}; |
150 | if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) { |
151 | ok = ok || evaluate::IsActuallyConstant(*intExpr); |
152 | paramValue->SetExplicit(std::move(*intExpr)); |
153 | } |
154 | } else if (!context.HasError(symbol)) { |
155 | evaluate::SayWithDeclaration(messages, symbol, |
156 | "Value of type parameter '%s' (%s) is not convertible to its type (%s)"_err_en_US, |
157 | name, expr->AsFortran(), dyType.AsFortran()); |
158 | } |
159 | } |
160 | } else { |
161 | // Default type parameter value expressions are folded within |
162 | // the scope of the derived type being instantiated. |
163 | const TypeParamDetails &details{symbol.get<TypeParamDetails>()}; |
164 | if (details.init() && details.attr()) { |
165 | evaluate::DynamicType dyType{TypeCategory::Integer, parameterKind}; |
166 | if (auto converted{ |
167 | evaluate::ConvertToType(dyType, SomeExpr{*details.init()})}) { |
168 | auto restorer{foldingContext.WithPDTInstance(*this)}; |
169 | SomeExpr folded{ |
170 | evaluate::Fold(foldingContext, std::move(*converted))}; |
171 | ok = ok || evaluate::IsActuallyConstant(folded); |
172 | AddParamValue(name, |
173 | ParamValue{std::move(std::get<SomeIntExpr>(folded.u)), |
174 | details.attr().value()}); |
175 | } else { |
176 | if (!context.HasError(symbol)) { |
177 | evaluate::SayWithDeclaration(messages, symbol, |
178 | "Default value of type parameter '%s' (%s) is not convertible to its type (%s)"_err_en_US, |
179 | name, details.init()->AsFortran(), dyType.AsFortran()); |
180 | } |
181 | } |
182 | } else if (!context.HasError(symbol)) { |
183 | messages.Say(name_, |
184 | "Type parameter '%s' lacks a value and has no default"_err_en_US, |
185 | name); |
186 | } |
187 | } |
188 | if (!ok && !context.HasError(symbol)) { |
189 | messages.Say( |
190 | "Value of KIND type parameter '%s' must be constant"_err_en_US, name); |
191 | } |
192 | } |
193 | } |
194 | |
195 | void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) { |
196 | CHECK(cooked_); |
197 | auto pair{parameters_.insert(std::make_pair(name, std::move(value)))}; |
198 | CHECK(pair.second); // name was not already present |
199 | } |
200 | |
201 | bool DerivedTypeSpec::MightBeParameterized() const { |
202 | return !cooked_ || !parameters_.empty(); |
203 | } |
204 | |
205 | bool DerivedTypeSpec::IsForwardReferenced() const { |
206 | return typeSymbol_.get<DerivedTypeDetails>().isForwardReferenced(); |
207 | } |
208 | |
209 | bool DerivedTypeSpec::HasDefaultInitialization( |
210 | bool ignoreAllocatable, bool ignorePointer) const { |
211 | DirectComponentIterator components{*this}; |
212 | return bool{std::find_if( |
213 | components.begin(), components.end(), [&](const Symbol &component) { |
214 | return IsInitialized(component, /*ignoreDataStatements=*/true, |
215 | ignoreAllocatable, ignorePointer); |
216 | })}; |
217 | } |
218 | |
219 | bool DerivedTypeSpec::HasDestruction() const { |
220 | if (!FinalsForDerivedTypeInstantiation(*this).empty()) { |
221 | return true; |
222 | } |
223 | DirectComponentIterator components{*this}; |
224 | return bool{std::find_if( |
225 | components.begin(), components.end(), [&](const Symbol &component) { |
226 | return IsDestructible(component, &typeSymbol()); |
227 | })}; |
228 | } |
229 | |
230 | ParamValue *DerivedTypeSpec::FindParameter(SourceName target) { |
231 | return const_cast<ParamValue *>( |
232 | const_cast<const DerivedTypeSpec *>(this)->FindParameter(target)); |
233 | } |
234 | |
235 | static bool MatchKindParams(const Symbol &typeSymbol, |
236 | const DerivedTypeSpec &thisSpec, const DerivedTypeSpec &thatSpec) { |
237 | for (auto ref : typeSymbol.get<DerivedTypeDetails>().paramNameOrder()) { |
238 | if (ref->get<TypeParamDetails>().attr() == common::TypeParamAttr::Kind) { |
239 | const auto *thisValue{thisSpec.FindParameter(ref->name())}; |
240 | const auto *thatValue{thatSpec.FindParameter(ref->name())}; |
241 | if (!thisValue || !thatValue || *thisValue != *thatValue) { |
242 | return false; |
243 | } |
244 | } |
245 | } |
246 | if (const DerivedTypeSpec * |
247 | parent{typeSymbol.GetParentTypeSpec(typeSymbol.scope())}) { |
248 | return MatchKindParams(parent->typeSymbol(), thisSpec, thatSpec); |
249 | } else { |
250 | return true; |
251 | } |
252 | } |
253 | |
254 | bool DerivedTypeSpec::MatchesOrExtends(const DerivedTypeSpec &that) const { |
255 | const Symbol *typeSymbol{&typeSymbol_}; |
256 | while (typeSymbol != &that.typeSymbol_) { |
257 | if (const DerivedTypeSpec * |
258 | parent{typeSymbol->GetParentTypeSpec(typeSymbol->scope())}) { |
259 | typeSymbol = &parent->typeSymbol_; |
260 | } else { |
261 | return false; |
262 | } |
263 | } |
264 | return MatchKindParams(*typeSymbol, *this, that); |
265 | } |
266 | |
267 | class InstantiateHelper { |
268 | public: |
269 | InstantiateHelper(Scope &scope) : scope_{scope} {} |
270 | // Instantiate components from fromScope into scope_ |
271 | void InstantiateComponents(const Scope &); |
272 | |
273 | private: |
274 | SemanticsContext &context() const { return scope_.context(); } |
275 | evaluate::FoldingContext &foldingContext() { |
276 | return context().foldingContext(); |
277 | } |
278 | template <typename A> A Fold(A &&expr) { |
279 | return evaluate::Fold(foldingContext(), std::move(expr)); |
280 | } |
281 | void InstantiateComponent(const Symbol &); |
282 | const DeclTypeSpec *InstantiateType(const Symbol &); |
283 | const DeclTypeSpec &InstantiateIntrinsicType( |
284 | SourceName, const DeclTypeSpec &); |
285 | DerivedTypeSpec CreateDerivedTypeSpec(const DerivedTypeSpec &, bool); |
286 | |
287 | Scope &scope_; |
288 | }; |
289 | |
290 | static int PlumbPDTInstantiationDepth(const Scope *scope) { |
291 | int depth{0}; |
292 | while (scope->IsParameterizedDerivedTypeInstantiation()) { |
293 | ++depth; |
294 | scope = &scope->parent(); |
295 | } |
296 | return depth; |
297 | } |
298 | |
299 | // Completes component derived type instantiation and initializer folding |
300 | // for a non-parameterized derived type Scope. |
301 | static void InstantiateNonPDTScope(Scope &typeScope, Scope &containingScope) { |
302 | auto &context{containingScope.context()}; |
303 | auto &foldingContext{context.foldingContext()}; |
304 | for (auto &pair : typeScope) { |
305 | Symbol &symbol{*pair.second}; |
306 | if (DeclTypeSpec * type{symbol.GetType()}) { |
307 | if (DerivedTypeSpec * derived{type->AsDerived()}) { |
308 | if (!(derived->IsForwardReferenced() && |
309 | IsAllocatableOrPointer(symbol))) { |
310 | derived->Instantiate(containingScope); |
311 | } |
312 | } |
313 | } |
314 | if (!IsPointer(symbol)) { |
315 | if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) { |
316 | if (MaybeExpr & init{object->init()}) { |
317 | auto restorer{foldingContext.messages().SetLocation(symbol.name())}; |
318 | init = evaluate::NonPointerInitializationExpr( |
319 | symbol, std::move(*init), foldingContext); |
320 | } |
321 | } |
322 | } |
323 | } |
324 | ComputeOffsets(context, typeScope); |
325 | } |
326 | |
327 | void DerivedTypeSpec::Instantiate(Scope &containingScope) { |
328 | if (instantiated_) { |
329 | return; |
330 | } |
331 | instantiated_ = true; |
332 | auto &context{containingScope.context()}; |
333 | auto &foldingContext{context.foldingContext()}; |
334 | if (IsForwardReferenced()) { |
335 | foldingContext.messages().Say(typeSymbol_.name(), |
336 | "The derived type '%s' was forward-referenced but not defined"_err_en_US, |
337 | typeSymbol_.name()); |
338 | context.SetError(typeSymbol_); |
339 | return; |
340 | } |
341 | EvaluateParameters(context); |
342 | const Scope &typeScope{DEREF(typeSymbol_.scope())}; |
343 | if (!MightBeParameterized()) { |
344 | scope_ = &typeScope; |
345 | if (!typeScope.derivedTypeSpec() || *this != *typeScope.derivedTypeSpec()) { |
346 | Scope &mutableTypeScope{const_cast<Scope &>(typeScope)}; |
347 | mutableTypeScope.set_derivedTypeSpec(*this); |
348 | InstantiateNonPDTScope(mutableTypeScope, containingScope); |
349 | } |
350 | return; |
351 | } |
352 | // New PDT instantiation. Create a new scope and populate it |
353 | // with components that have been specialized for this set of |
354 | // parameters. |
355 | Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)}; |
356 | newScope.set_derivedTypeSpec(*this); |
357 | ReplaceScope(newScope); |
358 | auto restorer{foldingContext.WithPDTInstance(*this)}; |
359 | std::string desc{typeSymbol_.name().ToString()}; |
360 | char sep{'('}; |
361 | for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) { |
362 | const SourceName &name{symbol.name()}; |
363 | if (typeScope.find(symbol.name()) != typeScope.end()) { |
364 | // This type parameter belongs to the derived type itself, not to |
365 | // one of its ancestors. Put the type parameter expression value, |
366 | // when there is one, into the new scope as the initialization value |
367 | // for the parameter. And when there is no explicit value, add an |
368 | // uninitialized type parameter to forestall use of any default. |
369 | if (ParamValue * paramValue{FindParameter(name)}) { |
370 | const TypeParamDetails &details{symbol.get<TypeParamDetails>()}; |
371 | TypeParamDetails instanceDetails{}; |
372 | if (details.attr()) { |
373 | paramValue->set_attr(*details.attr()); |
374 | instanceDetails.set_attr(*details.attr()); |
375 | } |
376 | desc += sep; |
377 | desc += name.ToString(); |
378 | desc += '='; |
379 | sep = ','; |
380 | if (MaybeIntExpr expr{paramValue->GetExplicit()}) { |
381 | desc += expr->AsFortran(); |
382 | instanceDetails.set_init( |
383 | std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*expr)))); |
384 | if (auto dyType{expr->GetType()}) { |
385 | instanceDetails.set_type(newScope.MakeNumericType( |
386 | TypeCategory::Integer, KindExpr{dyType->kind()})); |
387 | } |
388 | } |
389 | if (!instanceDetails.type()) { |
390 | if (const DeclTypeSpec * type{details.type()}) { |
391 | instanceDetails.set_type(*type); |
392 | } |
393 | } |
394 | if (!instanceDetails.init()) { |
395 | desc += '*'; |
396 | } |
397 | newScope.try_emplace(name, std::move(instanceDetails)); |
398 | } |
399 | } |
400 | } |
401 | parser::Message *contextMessage{nullptr}; |
402 | if (sep != '(') { |
403 | desc += ')'; |
404 | contextMessage = new parser::Message{foldingContext.messages().at(), |
405 | "instantiation of parameterized derived type '%s'"_en_US, desc}; |
406 | if (auto outer{containingScope.instantiationContext()}) { |
407 | contextMessage->SetContext(outer.get()); |
408 | } |
409 | newScope.set_instantiationContext(contextMessage); |
410 | } |
411 | // Instantiate nearly every non-parameter symbol from the original derived |
412 | // type's scope into the new instance. |
413 | auto restorer2{foldingContext.messages().SetContext(contextMessage)}; |
414 | if (PlumbPDTInstantiationDepth(&containingScope) > 100) { |
415 | foldingContext.messages().Say( |
416 | "Too many recursive parameterized derived type instantiations"_err_en_US); |
417 | } else { |
418 | InstantiateHelper{newScope}.InstantiateComponents(typeScope); |
419 | } |
420 | } |
421 | |
422 | void InstantiateHelper::InstantiateComponents(const Scope &fromScope) { |
423 | // Instantiate symbols in declaration order; this ensures that |
424 | // parent components and type parameters of ancestor types exist |
425 | // by the time that they're needed. |
426 | for (SymbolRef ref : fromScope.GetSymbols()) { |
427 | InstantiateComponent(*ref); |
428 | } |
429 | ComputeOffsets(context(), scope_); |
430 | } |
431 | |
432 | // Walks a parsed expression to prepare it for (re)analysis; |
433 | // clears out the typedExpr analysis results and re-resolves |
434 | // symbol table pointers of type parameters. |
435 | class ComponentInitResetHelper { |
436 | public: |
437 | explicit ComponentInitResetHelper(Scope &scope) : scope_{scope} {} |
438 | |
439 | template <typename A> bool Pre(const A &) { return true; } |
440 | |
441 | template <typename A> void Post(const A &x) { |
442 | if constexpr (parser::HasTypedExpr<A>()) { |
443 | x.typedExpr.Reset(); |
444 | } |
445 | } |
446 | |
447 | void Post(const parser::Name &name) { |
448 | if (name.symbol && name.symbol->has<TypeParamDetails>()) { |
449 | name.symbol = scope_.FindComponent(name.source); |
450 | } |
451 | } |
452 | |
453 | private: |
454 | Scope &scope_; |
455 | }; |
456 | |
457 | void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) { |
458 | auto pair{scope_.try_emplace( |
459 | oldSymbol.name(), oldSymbol.attrs(), common::Clone(oldSymbol.details()))}; |
460 | Symbol &newSymbol{*pair.first->second}; |
461 | if (!pair.second) { |
462 | // Symbol was already present in the scope, which can only happen |
463 | // in the case of type parameters. |
464 | CHECK(oldSymbol.has<TypeParamDetails>()); |
465 | return; |
466 | } |
467 | newSymbol.flags() = oldSymbol.flags(); |
468 | if (auto *details{newSymbol.detailsIf<ObjectEntityDetails>()}) { |
469 | if (const DeclTypeSpec * newType{InstantiateType(newSymbol)}) { |
470 | details->ReplaceType(*newType); |
471 | } |
472 | for (ShapeSpec &dim : details->shape()) { |
473 | if (dim.lbound().isExplicit()) { |
474 | dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit()))); |
475 | } |
476 | if (dim.ubound().isExplicit()) { |
477 | dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit()))); |
478 | } |
479 | } |
480 | for (ShapeSpec &dim : details->coshape()) { |
481 | if (dim.lbound().isExplicit()) { |
482 | dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit()))); |
483 | } |
484 | if (dim.ubound().isExplicit()) { |
485 | dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit()))); |
486 | } |
487 | } |
488 | if (const auto *parsedExpr{details->unanalyzedPDTComponentInit()}) { |
489 | // Analyze the parsed expression in this PDT instantiation context. |
490 | ComponentInitResetHelper resetter{scope_}; |
491 | parser::Walk(*parsedExpr, resetter); |
492 | auto restorer{foldingContext().messages().SetLocation(newSymbol.name())}; |
493 | details->set_init(evaluate::Fold( |
494 | foldingContext(), AnalyzeExpr(context(), *parsedExpr))); |
495 | details->set_unanalyzedPDTComponentInit(nullptr); |
496 | // Remove analysis results to prevent unparsing or other use of |
497 | // instantiation-specific expressions. |
498 | parser::Walk(*parsedExpr, resetter); |
499 | } |
500 | if (MaybeExpr & init{details->init()}) { |
501 | // Non-pointer components with default initializers are |
502 | // processed now so that those default initializers can be used |
503 | // in PARAMETER structure constructors. |
504 | auto restorer{foldingContext().messages().SetLocation(newSymbol.name())}; |
505 | init = IsPointer(newSymbol) |
506 | ? Fold(std::move(*init)) |
507 | : evaluate::NonPointerInitializationExpr( |
508 | newSymbol, std::move(*init), foldingContext()); |
509 | } |
510 | } else if (auto *procDetails{newSymbol.detailsIf<ProcEntityDetails>()}) { |
511 | // We have a procedure pointer. Instantiate its return type |
512 | if (const DeclTypeSpec * returnType{InstantiateType(newSymbol)}) { |
513 | if (!procDetails->procInterface()) { |
514 | procDetails->ReplaceType(*returnType); |
515 | } |
516 | } |
517 | } |
518 | } |
519 | |
520 | const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) { |
521 | const DeclTypeSpec *type{symbol.GetType()}; |
522 | if (!type) { |
523 | return nullptr; // error has occurred |
524 | } else if (const DerivedTypeSpec * spec{type->AsDerived()}) { |
525 | return &FindOrInstantiateDerivedType(scope_, |
526 | CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)), |
527 | type->category()); |
528 | } else if (type->AsIntrinsic()) { |
529 | return &InstantiateIntrinsicType(symbol.name(), *type); |
530 | } else if (type->category() == DeclTypeSpec::ClassStar) { |
531 | return type; |
532 | } else { |
533 | common::die("InstantiateType: %s", type->AsFortran().c_str()); |
534 | } |
535 | } |
536 | |
537 | /// Fold explicit length parameters of character components when the explicit |
538 | /// expression is a constant expression (if it only depends on KIND parameters). |
539 | /// Do not fold `character(len=pdt_length)`, even if the length parameter is |
540 | /// constant in the pdt instantiation, in order to avoid losing the information |
541 | /// that the character component is automatic (and must be a descriptor). |
542 | static ParamValue FoldCharacterLength(evaluate::FoldingContext &foldingContext, |
543 | const CharacterTypeSpec &characterSpec) { |
544 | if (const auto &len{characterSpec.length().GetExplicit()}) { |
545 | if (evaluate::IsConstantExpr(*len)) { |
546 | return ParamValue{evaluate::Fold(foldingContext, common::Clone(*len)), |
547 | common::TypeParamAttr::Len}; |
548 | } |
549 | } |
550 | return characterSpec.length(); |
551 | } |
552 | |
553 | // Apply type parameter values to an intrinsic type spec. |
554 | const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType( |
555 | SourceName symbolName, const DeclTypeSpec &spec) { |
556 | const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())}; |
557 | if (spec.category() != DeclTypeSpec::Character && |
558 | evaluate::IsActuallyConstant(intrinsic.kind())) { |
559 | return spec; // KIND is already a known constant |
560 | } |
561 | // The expression was not originally constant, but now it must be so |
562 | // in the context of a parameterized derived type instantiation. |
563 | KindExpr copy{Fold(common::Clone(intrinsic.kind()))}; |
564 | int kind{context().GetDefaultKind(intrinsic.category())}; |
565 | if (auto value{evaluate::ToInt64(copy)}) { |
566 | if (foldingContext().targetCharacteristics().IsTypeEnabled( |
567 | intrinsic.category(), *value)) { |
568 | kind = *value; |
569 | } else { |
570 | foldingContext().messages().Say(symbolName, |
571 | "KIND parameter value (%jd) of intrinsic type %s did not resolve to a supported value"_err_en_US, |
572 | *value, |
573 | parser::ToUpperCaseLetters(EnumToString(intrinsic.category()))); |
574 | } |
575 | } else { |
576 | std::string exprString; |
577 | llvm::raw_string_ostream sstream(exprString); |
578 | copy.AsFortran(sstream); |
579 | foldingContext().messages().Say(symbolName, |
580 | "KIND parameter expression (%s) of intrinsic type %s did not resolve to a constant value"_err_en_US, |
581 | exprString, |
582 | parser::ToUpperCaseLetters(EnumToString(intrinsic.category()))); |
583 | } |
584 | switch (spec.category()) { |
585 | case DeclTypeSpec::Numeric: |
586 | return scope_.MakeNumericType(intrinsic.category(), KindExpr{kind}); |
587 | case DeclTypeSpec::Logical: |
588 | return scope_.MakeLogicalType(KindExpr{kind}); |
589 | case DeclTypeSpec::Character: |
590 | return scope_.MakeCharacterType( |
591 | FoldCharacterLength(foldingContext(), spec.characterTypeSpec()), |
592 | KindExpr{kind}); |
593 | default: |
594 | CRASH_NO_CASE; |
595 | } |
596 | } |
597 | |
598 | DerivedTypeSpec InstantiateHelper::CreateDerivedTypeSpec( |
599 | const DerivedTypeSpec &spec, bool isParentComp) { |
600 | DerivedTypeSpec result{spec}; |
601 | result.CookParameters(foldingContext()); // enables AddParamValue() |
602 | if (isParentComp) { |
603 | // Forward any explicit type parameter values from the |
604 | // derived type spec under instantiation that define type parameters |
605 | // of the parent component to the derived type spec of the |
606 | // parent component. |
607 | const DerivedTypeSpec &instanceSpec{DEREF(foldingContext().pdtInstance())}; |
608 | for (const auto &[name, value] : instanceSpec.parameters()) { |
609 | if (scope_.find(name) == scope_.end()) { |
610 | result.AddParamValue(name, ParamValue{value}); |
611 | } |
612 | } |
613 | } |
614 | return result; |
615 | } |
616 | |
617 | std::string DerivedTypeSpec::VectorTypeAsFortran() const { |
618 | std::string buf; |
619 | llvm::raw_string_ostream ss{buf}; |
620 | |
621 | switch (category()) { |
622 | SWITCH_COVERS_ALL_CASES |
623 | case (Fortran::semantics::DerivedTypeSpec::Category::IntrinsicVector): { |
624 | int64_t vecElemKind; |
625 | int64_t vecElemCategory; |
626 | |
627 | for (const auto &pair : parameters()) { |
628 | if (pair.first == "element_category") { |
629 | vecElemCategory = |
630 | Fortran::evaluate::ToInt64(pair.second.GetExplicit()).value_or(-1); |
631 | } else if (pair.first == "element_kind") { |
632 | vecElemKind = |
633 | Fortran::evaluate::ToInt64(pair.second.GetExplicit()).value_or(0); |
634 | } |
635 | } |
636 | |
637 | assert((vecElemCategory >= 0 && |
638 | static_cast<size_t>(vecElemCategory) < |
639 | Fortran::common::VectorElementCategory_enumSize) && |
640 | "Vector element type is not specified"); |
641 | assert(vecElemKind && "Vector element kind is not specified"); |
642 | |
643 | ss << "vector("; |
644 | switch (static_cast<common::VectorElementCategory>(vecElemCategory)) { |
645 | SWITCH_COVERS_ALL_CASES |
646 | case common::VectorElementCategory::Integer: |
647 | ss << "integer("<< vecElemKind << ")"; |
648 | break; |
649 | case common::VectorElementCategory::Unsigned: |
650 | ss << "unsigned("<< vecElemKind << ")"; |
651 | break; |
652 | case common::VectorElementCategory::Real: |
653 | ss << "real("<< vecElemKind << ")"; |
654 | break; |
655 | } |
656 | ss << ")"; |
657 | break; |
658 | } |
659 | case (Fortran::semantics::DerivedTypeSpec::Category::PairVector): |
660 | ss << "__vector_pair"; |
661 | break; |
662 | case (Fortran::semantics::DerivedTypeSpec::Category::QuadVector): |
663 | ss << "__vector_quad"; |
664 | break; |
665 | case (Fortran::semantics::DerivedTypeSpec::Category::DerivedType): |
666 | Fortran::common::die("Vector element type not implemented"); |
667 | } |
668 | return buf; |
669 | } |
670 | |
671 | std::string DerivedTypeSpec::AsFortran() const { |
672 | std::string buf; |
673 | llvm::raw_string_ostream ss{buf}; |
674 | ss << originalTypeSymbol_.name(); |
675 | if (!rawParameters_.empty()) { |
676 | CHECK(parameters_.empty()); |
677 | ss << '('; |
678 | bool first = true; |
679 | for (const auto &[maybeKeyword, value] : rawParameters_) { |
680 | if (first) { |
681 | first = false; |
682 | } else { |
683 | ss << ','; |
684 | } |
685 | if (maybeKeyword) { |
686 | ss << maybeKeyword->v.source.ToString() << '='; |
687 | } |
688 | ss << value.AsFortran(); |
689 | } |
690 | ss << ')'; |
691 | } else if (!parameters_.empty()) { |
692 | ss << '('; |
693 | bool first = true; |
694 | for (const auto &[name, value] : parameters_) { |
695 | if (first) { |
696 | first = false; |
697 | } else { |
698 | ss << ','; |
699 | } |
700 | ss << name.ToString() << '=' << value.AsFortran(); |
701 | } |
702 | ss << ')'; |
703 | } |
704 | return buf; |
705 | } |
706 | |
707 | llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) { |
708 | return o << x.AsFortran(); |
709 | } |
710 | |
711 | Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {} |
712 | |
713 | llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) { |
714 | if (x.isStar()) { |
715 | o << '*'; |
716 | } else if (x.isColon()) { |
717 | o << ':'; |
718 | } else if (x.expr_) { |
719 | x.expr_->AsFortran(o); |
720 | } else { |
721 | o << "<no-expr>"; |
722 | } |
723 | return o; |
724 | } |
725 | |
726 | llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ShapeSpec &x) { |
727 | if (x.lb_.isStar()) { |
728 | CHECK(x.ub_.isStar()); |
729 | o << ".."; |
730 | } else { |
731 | if (!x.lb_.isColon()) { |
732 | o << x.lb_; |
733 | } |
734 | o << ':'; |
735 | if (!x.ub_.isColon()) { |
736 | o << x.ub_; |
737 | } |
738 | } |
739 | return o; |
740 | } |
741 | |
742 | llvm::raw_ostream &operator<<( |
743 | llvm::raw_ostream &os, const ArraySpec &arraySpec) { |
744 | char sep{'('}; |
745 | for (auto &shape : arraySpec) { |
746 | os << sep << shape; |
747 | sep = ','; |
748 | } |
749 | if (sep == ',') { |
750 | os << ')'; |
751 | } |
752 | return os; |
753 | } |
754 | |
755 | ParamValue::ParamValue(MaybeIntExpr &&expr, common::TypeParamAttr attr) |
756 | : attr_{attr}, expr_{std::move(expr)} {} |
757 | ParamValue::ParamValue(SomeIntExpr &&expr, common::TypeParamAttr attr) |
758 | : attr_{attr}, expr_{std::move(expr)} {} |
759 | ParamValue::ParamValue( |
760 | common::ConstantSubscript value, common::TypeParamAttr attr) |
761 | : ParamValue(SomeIntExpr{evaluate::Expr<evaluate::SubscriptInteger>{value}}, |
762 | attr) {} |
763 | |
764 | void ParamValue::SetExplicit(SomeIntExpr &&x) { |
765 | category_ = Category::Explicit; |
766 | expr_ = std::move(x); |
767 | } |
768 | |
769 | std::string ParamValue::AsFortran() const { |
770 | switch (category_) { |
771 | SWITCH_COVERS_ALL_CASES |
772 | case Category::Assumed: |
773 | return "*"; |
774 | case Category::Deferred: |
775 | return ":"; |
776 | case Category::Explicit: |
777 | if (expr_) { |
778 | std::string buf; |
779 | llvm::raw_string_ostream ss{buf}; |
780 | expr_->AsFortran(ss); |
781 | return buf; |
782 | } else { |
783 | return ""; |
784 | } |
785 | } |
786 | } |
787 | |
788 | llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ParamValue &x) { |
789 | return o << x.AsFortran(); |
790 | } |
791 | |
792 | IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, KindExpr &&kind) |
793 | : category_{category}, kind_{std::move(kind)} { |
794 | CHECK(category != TypeCategory::Derived); |
795 | } |
796 | |
797 | static std::string KindAsFortran(const KindExpr &kind) { |
798 | std::string buf; |
799 | llvm::raw_string_ostream ss{buf}; |
800 | if (auto k{evaluate::ToInt64(kind)}) { |
801 | ss << *k; // emit unsuffixed kind code |
802 | } else { |
803 | kind.AsFortran(ss); |
804 | } |
805 | return buf; |
806 | } |
807 | |
808 | std::string IntrinsicTypeSpec::AsFortran() const { |
809 | return parser::ToUpperCaseLetters(common::EnumToString(category_)) + '(' + |
810 | KindAsFortran(kind_) + ')'; |
811 | } |
812 | |
813 | llvm::raw_ostream &operator<<( |
814 | llvm::raw_ostream &os, const IntrinsicTypeSpec &x) { |
815 | return os << x.AsFortran(); |
816 | } |
817 | |
818 | std::string CharacterTypeSpec::AsFortran() const { |
819 | return "CHARACTER("+ length_.AsFortran() + ',' + KindAsFortran(kind()) + ')'; |
820 | } |
821 | |
822 | llvm::raw_ostream &operator<<( |
823 | llvm::raw_ostream &os, const CharacterTypeSpec &x) { |
824 | return os << x.AsFortran(); |
825 | } |
826 | |
827 | DeclTypeSpec::DeclTypeSpec(NumericTypeSpec &&typeSpec) |
828 | : category_{Numeric}, typeSpec_{std::move(typeSpec)} {} |
829 | DeclTypeSpec::DeclTypeSpec(LogicalTypeSpec &&typeSpec) |
830 | : category_{Logical}, typeSpec_{std::move(typeSpec)} {} |
831 | DeclTypeSpec::DeclTypeSpec(const CharacterTypeSpec &typeSpec) |
832 | : category_{Character}, typeSpec_{typeSpec} {} |
833 | DeclTypeSpec::DeclTypeSpec(CharacterTypeSpec &&typeSpec) |
834 | : category_{Character}, typeSpec_{std::move(typeSpec)} {} |
835 | DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec) |
836 | : category_{category}, typeSpec_{typeSpec} { |
837 | CHECK(category == TypeDerived || category == ClassDerived); |
838 | } |
839 | DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &&typeSpec) |
840 | : category_{category}, typeSpec_{std::move(typeSpec)} { |
841 | CHECK(category == TypeDerived || category == ClassDerived); |
842 | } |
843 | DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} { |
844 | CHECK(category == TypeStar || category == ClassStar); |
845 | } |
846 | bool DeclTypeSpec::IsNumeric(TypeCategory tc) const { |
847 | return category_ == Numeric && numericTypeSpec().category() == tc; |
848 | } |
849 | bool DeclTypeSpec::IsSequenceType() const { |
850 | if (const DerivedTypeSpec * derivedType{AsDerived()}) { |
851 | const auto *typeDetails{ |
852 | derivedType->typeSymbol().detailsIf<DerivedTypeDetails>()}; |
853 | return typeDetails && typeDetails->sequence(); |
854 | } |
855 | return false; |
856 | } |
857 | |
858 | const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const { |
859 | CHECK(category_ == Numeric); |
860 | return std::get<NumericTypeSpec>(typeSpec_); |
861 | } |
862 | const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const { |
863 | CHECK(category_ == Logical); |
864 | return std::get<LogicalTypeSpec>(typeSpec_); |
865 | } |
866 | bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const { |
867 | return category_ == that.category_ && typeSpec_ == that.typeSpec_; |
868 | } |
869 | |
870 | std::string DeclTypeSpec::AsFortran() const { |
871 | switch (category_) { |
872 | SWITCH_COVERS_ALL_CASES |
873 | case Numeric: |
874 | return numericTypeSpec().AsFortran(); |
875 | case Logical: |
876 | return logicalTypeSpec().AsFortran(); |
877 | case Character: |
878 | return characterTypeSpec().AsFortran(); |
879 | case TypeDerived: |
880 | if (derivedTypeSpec() |
881 | .typeSymbol() |
882 | .get<DerivedTypeDetails>() |
883 | .isDECStructure()) { |
884 | return "RECORD"+ derivedTypeSpec().typeSymbol().name().ToString(); |
885 | } else if (derivedTypeSpec().IsVectorType()) { |
886 | return derivedTypeSpec().VectorTypeAsFortran(); |
887 | } else { |
888 | return "TYPE("+ derivedTypeSpec().AsFortran() + ')'; |
889 | } |
890 | case ClassDerived: |
891 | return "CLASS("+ derivedTypeSpec().AsFortran() + ')'; |
892 | case TypeStar: |
893 | return "TYPE(*)"; |
894 | case ClassStar: |
895 | return "CLASS(*)"; |
896 | } |
897 | } |
898 | |
899 | llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) { |
900 | return o << x.AsFortran(); |
901 | } |
902 | |
903 | } // namespace Fortran::semantics |
904 |
Definitions
- MatchKindParams
- InstantiateHelper
- InstantiateHelper
- context
- foldingContext
- Fold
- PlumbPDTInstantiationDepth
- InstantiateNonPDTScope
- InstantiateComponents
- ComponentInitResetHelper
- ComponentInitResetHelper
- Pre
- Post
- Post
- InstantiateComponent
- InstantiateType
- FoldCharacterLength
- InstantiateIntrinsicType
- CreateDerivedTypeSpec
- operator<<
- operator<<
- operator<<
- operator<<
- operator<<
- KindAsFortran
- operator<<
- operator<<
Learn to use CMake with our Intro Training
Find out more